{-# LANGUAGE DeriveGeneric, LambdaCase, DerivingVia, FlexibleInstances #-}
module ProjectM36.IsomorphicSchema where
import ProjectM36.Base
import ProjectM36.Error
import ProjectM36.MiscUtils
import ProjectM36.Relation
import ProjectM36.NormalizeExpr
import ProjectM36.RelationalExpression
import qualified ProjectM36.AttributeNames as AN
import Control.Monad
import GHC.Generics
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.List as L
import qualified Data.Vector as V
import qualified ProjectM36.Attribute as A
import ProjectM36.AtomType
#if __GLASGOW_HASKELL__ < 804
import Data.Monoid
#endif

-- isomorphic schemas offer bi-directional functors between two schemas

--TODO: note that renaming a relvar should alter any stored isomorphisms as well
--TODO: rel attrs rename or transform (needs bidirectional atom functions)
-- TODO: IsoRestrict should include requirement that union'd relations should retain the same tuple count (no tuples are lost or ambiguous between the two relations)
--TODO: allow morphs to stack (morph a schema to a new schema)
 -- this could be accomplished by morphing the morphs or by chain linking schemas so that they need not directly reference the underlying concrete schema

-- the isomorphic building blocks should not be arbitrarily combined; for example, combing restrict and union on the same target relvar does not make sense as that would create effects at a distance in the secondary schema

data SchemaExpr = AddSubschema SchemaName SchemaIsomorphs |
                  RemoveSubschema SchemaName
                  deriving ((forall x. SchemaExpr -> Rep SchemaExpr x)
-> (forall x. Rep SchemaExpr x -> SchemaExpr) -> Generic SchemaExpr
forall x. Rep SchemaExpr x -> SchemaExpr
forall x. SchemaExpr -> Rep SchemaExpr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SchemaExpr x -> SchemaExpr
$cfrom :: forall x. SchemaExpr -> Rep SchemaExpr x
Generic, Int -> SchemaExpr -> ShowS
[SchemaExpr] -> ShowS
SchemaExpr -> String
(Int -> SchemaExpr -> ShowS)
-> (SchemaExpr -> String)
-> ([SchemaExpr] -> ShowS)
-> Show SchemaExpr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SchemaExpr] -> ShowS
$cshowList :: [SchemaExpr] -> ShowS
show :: SchemaExpr -> String
$cshow :: SchemaExpr -> String
showsPrec :: Int -> SchemaExpr -> ShowS
$cshowsPrec :: Int -> SchemaExpr -> ShowS
Show)
  
isomorphs :: Schema -> SchemaIsomorphs
isomorphs :: Schema -> SchemaIsomorphs
isomorphs (Schema SchemaIsomorphs
i) = SchemaIsomorphs
i

-- | Return an error if the schema is not isomorphic to the base database context.
-- A schema is fully isomorphic iff all relvars in the base context are in the "out" relvars, but only once.
--TODO: add relvar must appear exactly once constraint
validateSchema :: Schema -> DatabaseContext -> Maybe SchemaError
validateSchema :: Schema -> DatabaseContext -> Maybe SchemaError
validateSchema Schema
potentialSchema DatabaseContext
baseContext | Bool -> Bool
not (Set RelVarName -> Bool
forall a. Set a -> Bool
S.null Set RelVarName
rvDiff) = SchemaError -> Maybe SchemaError
forall a. a -> Maybe a
Just (Set RelVarName -> SchemaError
RelVarReferencesMissing Set RelVarName
rvDiff)
                                           | Bool -> Bool
not ([RelVarName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RelVarName]
outDupes) = SchemaError -> Maybe SchemaError
forall a. a -> Maybe a
Just (RelVarName -> SchemaError
RelVarOutReferencedMoreThanOnce ([RelVarName] -> RelVarName
forall a. [a] -> a
head [RelVarName]
outDupes))
                                           | Bool -> Bool
not ([RelVarName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RelVarName]
inDupes) = SchemaError -> Maybe SchemaError
forall a. a -> Maybe a
Just (RelVarName -> SchemaError
RelVarInReferencedMoreThanOnce ([RelVarName] -> RelVarName
forall a. [a] -> a
head [RelVarName]
inDupes))                
                                           | Bool
otherwise = Maybe SchemaError
forall a. Maybe a
Nothing
  where
    --check that the predicate for IsoUnion and IsoRestrict holds right now
    outDupes :: [RelVarName]
outDupes = [RelVarName] -> [RelVarName]
duplicateNames ((SchemaIsomorph -> [RelVarName]) -> [RelVarName]
forall b. (SchemaIsomorph -> [b]) -> [b]
namesList SchemaIsomorph -> [RelVarName]
isomorphOutRelVarNames)
    inDupes :: [RelVarName]
inDupes = [RelVarName] -> [RelVarName]
duplicateNames ((SchemaIsomorph -> [RelVarName]) -> [RelVarName]
forall b. (SchemaIsomorph -> [b]) -> [b]
namesList SchemaIsomorph -> [RelVarName]
isomorphInRelVarNames)
    duplicateNames :: [RelVarName] -> [RelVarName]
duplicateNames = [RelVarName] -> [RelVarName]
forall a. Eq a => [a] -> [a]
dupes ([RelVarName] -> [RelVarName])
-> ([RelVarName] -> [RelVarName]) -> [RelVarName] -> [RelVarName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RelVarName] -> [RelVarName]
forall a. Ord a => [a] -> [a]
L.sort
    namesList :: (SchemaIsomorph -> [b]) -> [b]
namesList SchemaIsomorph -> [b]
isoFunc = (SchemaIsomorph -> [b]) -> SchemaIsomorphs -> [b]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SchemaIsomorph -> [b]
isoFunc (Schema -> SchemaIsomorphs
isomorphs Schema
potentialSchema)
    expectedRelVars :: Set RelVarName
expectedRelVars = Map RelVarName GraphRefRelationalExpr -> Set RelVarName
forall k a. Map k a -> Set k
M.keysSet (DatabaseContext -> Map RelVarName GraphRefRelationalExpr
relationVariables DatabaseContext
baseContext)
    schemaRelVars :: Set RelVarName
schemaRelVars = SchemaIsomorphs -> Set RelVarName
isomorphsOutRelVarNames (Schema -> SchemaIsomorphs
isomorphs Schema
potentialSchema)
    rvDiff :: Set RelVarName
rvDiff = Set RelVarName -> Set RelVarName -> Set RelVarName
forall a. Ord a => Set a -> Set a -> Set a
S.difference Set RelVarName
expectedRelVars Set RelVarName
schemaRelVars

-- useful for transforming a concrete context into a virtual schema and vice versa
invert :: SchemaIsomorph -> SchemaIsomorph
invert :: SchemaIsomorph -> SchemaIsomorph
invert (IsoRename RelVarName
rvIn RelVarName
rvOut) = RelVarName -> RelVarName -> SchemaIsomorph
IsoRename RelVarName
rvOut RelVarName
rvIn
invert (IsoRestrict RelVarName
rvIn RestrictionPredicateExpr
predi (RelVarName
rvAOut, RelVarName
rvBOut)) = (RelVarName, RelVarName)
-> RestrictionPredicateExpr -> RelVarName -> SchemaIsomorph
IsoUnion (RelVarName
rvAOut, RelVarName
rvBOut) RestrictionPredicateExpr
predi RelVarName
rvIn
invert (IsoUnion (RelVarName
rvAIn, RelVarName
rvBIn) RestrictionPredicateExpr
predi RelVarName
rvOut) = RelVarName
-> RestrictionPredicateExpr
-> (RelVarName, RelVarName)
-> SchemaIsomorph
IsoRestrict RelVarName
rvOut RestrictionPredicateExpr
predi (RelVarName
rvAIn, RelVarName
rvBIn)

isomorphInRelVarNames :: SchemaIsomorph -> [RelVarName]
isomorphInRelVarNames :: SchemaIsomorph -> [RelVarName]
isomorphInRelVarNames (IsoRestrict RelVarName
rv RestrictionPredicateExpr
_ (RelVarName, RelVarName)
_) = [RelVarName
rv]
isomorphInRelVarNames (IsoUnion (RelVarName
rvA, RelVarName
rvB) RestrictionPredicateExpr
_ RelVarName
_) = [RelVarName
rvA, RelVarName
rvB]
isomorphInRelVarNames (IsoRename RelVarName
rv RelVarName
_) = [RelVarName
rv]

-- | Relation variables names represented in the virtual schema space. Useful for determining if a relvar name is valid in the schema.
isomorphsInRelVarNames :: SchemaIsomorphs -> S.Set RelVarName
isomorphsInRelVarNames :: SchemaIsomorphs -> Set RelVarName
isomorphsInRelVarNames SchemaIsomorphs
morphs = [RelVarName] -> Set RelVarName
forall a. Ord a => [a] -> Set a
S.fromList ((SchemaIsomorph -> [RelVarName] -> [RelVarName])
-> [RelVarName] -> SchemaIsomorphs -> [RelVarName]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr SchemaIsomorph -> [RelVarName] -> [RelVarName]
rvnames [] SchemaIsomorphs
morphs)
  where
    rvnames :: SchemaIsomorph -> [RelVarName] -> [RelVarName]
rvnames SchemaIsomorph
morph [RelVarName]
acc = [RelVarName]
acc [RelVarName] -> [RelVarName] -> [RelVarName]
forall a. [a] -> [a] -> [a]
++ SchemaIsomorph -> [RelVarName]
isomorphInRelVarNames SchemaIsomorph
morph
    
isomorphOutRelVarNames :: SchemaIsomorph -> [RelVarName]    
isomorphOutRelVarNames :: SchemaIsomorph -> [RelVarName]
isomorphOutRelVarNames (IsoRestrict RelVarName
_ RestrictionPredicateExpr
_ (RelVarName
rvA, RelVarName
rvB)) = [RelVarName
rvA, RelVarName
rvB]
isomorphOutRelVarNames (IsoUnion (RelVarName, RelVarName)
_ RestrictionPredicateExpr
_ RelVarName
rv) = [RelVarName
rv]
isomorphOutRelVarNames (IsoRename RelVarName
_ RelVarName
rv) = [RelVarName
rv]

isomorphsOutRelVarNames :: SchemaIsomorphs -> S.Set RelVarName
isomorphsOutRelVarNames :: SchemaIsomorphs -> Set RelVarName
isomorphsOutRelVarNames SchemaIsomorphs
morphs = [RelVarName] -> Set RelVarName
forall a. Ord a => [a] -> Set a
S.fromList ((SchemaIsomorph -> [RelVarName] -> [RelVarName])
-> [RelVarName] -> SchemaIsomorphs -> [RelVarName]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr SchemaIsomorph -> [RelVarName] -> [RelVarName]
rvnames [] SchemaIsomorphs
morphs)
  where
    rvnames :: SchemaIsomorph -> [RelVarName] -> [RelVarName]
rvnames SchemaIsomorph
morph [RelVarName]
acc = [RelVarName]
acc [RelVarName] -> [RelVarName] -> [RelVarName]
forall a. [a] -> [a] -> [a]
++ SchemaIsomorph -> [RelVarName]
isomorphOutRelVarNames SchemaIsomorph
morph

-- | Check that all mentioned relvars are actually present in the current schema.
validateRelationalExprInSchema :: Schema -> RelationalExpr -> Either RelationalError ()
validateRelationalExprInSchema :: Schema -> RelationalExpr -> Either RelationalError ()
validateRelationalExprInSchema Schema
schema RelationalExpr
relExprIn =
  Either RelationalError RelationalExpr -> Either RelationalError ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Either RelationalError RelationalExpr
 -> Either RelationalError ())
-> Either RelationalError RelationalExpr
-> Either RelationalError ()
forall a b. (a -> b) -> a -> b
$ (RelationalExpr -> Either RelationalError RelationalExpr)
-> RelationalExpr -> Either RelationalError RelationalExpr
forall a.
(RelationalExprBase a
 -> Either RelationalError (RelationalExprBase a))
-> RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
relExprMogrify (\case
                            RelationVariable RelVarName
rv () | RelVarName -> Set RelVarName -> Bool
forall a. Ord a => a -> Set a -> Bool
S.notMember RelVarName
rv Set RelVarName
validRelVarNames -> RelationalError -> Either RelationalError RelationalExpr
forall a b. a -> Either a b
Left (RelVarName -> RelationalError
RelVarNotDefinedError RelVarName
rv)
                            RelationalExpr
ex -> RelationalExpr -> Either RelationalError RelationalExpr
forall a b. b -> Either a b
Right RelationalExpr
ex) RelationalExpr
relExprIn
  where
    validRelVarNames :: Set RelVarName
validRelVarNames = SchemaIsomorphs -> Set RelVarName
isomorphsInRelVarNames (Schema -> SchemaIsomorphs
isomorphs Schema
schema)
  
processRelationalExprInSchema :: Schema -> RelationalExpr -> Either RelationalError RelationalExpr
processRelationalExprInSchema :: Schema -> RelationalExpr -> Either RelationalError RelationalExpr
processRelationalExprInSchema (Schema []) RelationalExpr
expr = RelationalExpr -> Either RelationalError RelationalExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure RelationalExpr
expr
processRelationalExprInSchema Schema
schema RelationalExpr
relExprIn = do
  --validate that all rvs are present in the virtual schema- this prevents relation variables being referenced in the underlying schema (falling through the transformation)
  let processRelExpr :: RelationalExpr
-> SchemaIsomorph -> Either RelationalError RelationalExpr
processRelExpr RelationalExpr
rexpr SchemaIsomorph
morph = (RelationalExpr -> Either RelationalError RelationalExpr)
-> RelationalExpr -> Either RelationalError RelationalExpr
forall a.
(RelationalExprBase a
 -> Either RelationalError (RelationalExprBase a))
-> RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
relExprMogrify (SchemaIsomorph
-> RelationalExpr -> Either RelationalError RelationalExpr
relExprMorph SchemaIsomorph
morph) RelationalExpr
rexpr
  Schema -> RelationalExpr -> Either RelationalError ()
validateRelationalExprInSchema Schema
schema RelationalExpr
relExprIn                    
  (RelationalExpr
 -> SchemaIsomorph -> Either RelationalError RelationalExpr)
-> RelationalExpr
-> SchemaIsomorphs
-> Either RelationalError RelationalExpr
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM RelationalExpr
-> SchemaIsomorph -> Either RelationalError RelationalExpr
processRelExpr RelationalExpr
relExprIn (Schema -> SchemaIsomorphs
isomorphs Schema
schema)

validateDatabaseContextExprInSchema :: Schema -> DatabaseContextExpr -> Either RelationalError ()  
validateDatabaseContextExprInSchema :: Schema -> DatabaseContextExpr -> Either RelationalError ()
validateDatabaseContextExprInSchema Schema
schema DatabaseContextExpr
dbExpr = (SchemaIsomorph -> Either RelationalError DatabaseContextExpr)
-> SchemaIsomorphs -> Either RelationalError ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\SchemaIsomorph
morph -> SchemaIsomorph
-> (RelationalExpr -> Either RelationalError RelationalExpr)
-> DatabaseContextExpr
-> Either RelationalError DatabaseContextExpr
databaseContextExprMorph SchemaIsomorph
morph (\RelationalExpr
e -> Schema -> RelationalExpr -> Either RelationalError ()
validateRelationalExprInSchema Schema
schema RelationalExpr
e Either RelationalError ()
-> Either RelationalError RelationalExpr
-> Either RelationalError RelationalExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RelationalExpr -> Either RelationalError RelationalExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure RelationalExpr
e) DatabaseContextExpr
dbExpr) (Schema -> SchemaIsomorphs
isomorphs Schema
schema)
  
processDatabaseContextExprInSchema :: Schema -> DatabaseContextExpr -> Either RelationalError DatabaseContextExpr  
processDatabaseContextExprInSchema :: Schema
-> DatabaseContextExpr
-> Either RelationalError DatabaseContextExpr
processDatabaseContextExprInSchema schema :: Schema
schema@(Schema SchemaIsomorphs
morphs) DatabaseContextExpr
dbExpr = do
  let relExprMogrifier :: RelationalExpr -> Either RelationalError RelationalExpr
relExprMogrifier = Schema -> RelationalExpr -> Either RelationalError RelationalExpr
processRelationalExprInSchema Schema
schema
  --validate that all mentioned relvars are in the valid set
  ()
_ <- Schema -> DatabaseContextExpr -> Either RelationalError ()
validateDatabaseContextExprInSchema Schema
schema DatabaseContextExpr
dbExpr      
  --perform the morph
  (DatabaseContextExpr
 -> SchemaIsomorph -> Either RelationalError DatabaseContextExpr)
-> DatabaseContextExpr
-> SchemaIsomorphs
-> Either RelationalError DatabaseContextExpr
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\DatabaseContextExpr
ex SchemaIsomorph
morph -> SchemaIsomorph
-> (RelationalExpr -> Either RelationalError RelationalExpr)
-> DatabaseContextExpr
-> Either RelationalError DatabaseContextExpr
databaseContextExprMorph SchemaIsomorph
morph RelationalExpr -> Either RelationalError RelationalExpr
relExprMogrifier DatabaseContextExpr
ex) DatabaseContextExpr
dbExpr SchemaIsomorphs
morphs

-- | If the database context expression adds or removes a relvar, we need to update the isomorphs to create a passthrough Isomorph.
processDatabaseContextExprSchemaUpdate :: Schema -> DatabaseContextExpr -> Schema
processDatabaseContextExprSchemaUpdate :: Schema -> DatabaseContextExpr -> Schema
processDatabaseContextExprSchemaUpdate schema :: Schema
schema@(Schema SchemaIsomorphs
morphs) DatabaseContextExpr
expr = case DatabaseContextExpr
expr of
  Define RelVarName
rv [AttributeExprBase ()]
_ | RelVarName -> Set RelVarName -> Bool
forall a. Ord a => a -> Set a -> Bool
S.notMember RelVarName
rv Set RelVarName
validSchemaName -> RelVarName -> Schema
passthru RelVarName
rv
  Assign RelVarName
rv RelationalExpr
_ | RelVarName -> Set RelVarName -> Bool
forall a. Ord a => a -> Set a -> Bool
S.notMember RelVarName
rv Set RelVarName
validSchemaName -> RelVarName -> Schema
passthru RelVarName
rv
  Undefine RelVarName
rv | RelVarName -> Set RelVarName -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member RelVarName
rv Set RelVarName
validSchemaName -> SchemaIsomorphs -> Schema
Schema ((SchemaIsomorph -> Bool) -> SchemaIsomorphs -> SchemaIsomorphs
forall a. (a -> Bool) -> [a] -> [a]
filter (RelVarName -> [RelVarName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem RelVarName
rv ([RelVarName] -> Bool)
-> (SchemaIsomorph -> [RelVarName]) -> SchemaIsomorph -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SchemaIsomorph -> [RelVarName]
isomorphInRelVarNames) SchemaIsomorphs
morphs)
  MultipleExpr [DatabaseContextExpr]
exprs -> (DatabaseContextExpr -> Schema -> Schema)
-> Schema -> [DatabaseContextExpr] -> Schema
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Schema -> DatabaseContextExpr -> Schema)
-> DatabaseContextExpr -> Schema -> Schema
forall a b c. (a -> b -> c) -> b -> a -> c
flip Schema -> DatabaseContextExpr -> Schema
processDatabaseContextExprSchemaUpdate) Schema
schema [DatabaseContextExpr]
exprs
  DatabaseContextExpr
_ -> Schema
schema
  where
    validSchemaName :: Set RelVarName
validSchemaName = SchemaIsomorphs -> Set RelVarName
isomorphsInRelVarNames SchemaIsomorphs
morphs
    passthru :: RelVarName -> Schema
passthru RelVarName
rvname = SchemaIsomorphs -> Schema
Schema (SchemaIsomorphs
morphs SchemaIsomorphs -> SchemaIsomorphs -> SchemaIsomorphs
forall a. [a] -> [a] -> [a]
++ [RelVarName -> RelVarName -> SchemaIsomorph
IsoRename RelVarName
rvname RelVarName
rvname])
    
processDatabaseContextExprSchemasUpdate :: Subschemas -> DatabaseContextExpr -> Subschemas    
processDatabaseContextExprSchemasUpdate :: Subschemas -> DatabaseContextExpr -> Subschemas
processDatabaseContextExprSchemasUpdate Subschemas
subschemas DatabaseContextExpr
expr = (Schema -> Schema) -> Subschemas -> Subschemas
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (Schema -> DatabaseContextExpr -> Schema
`processDatabaseContextExprSchemaUpdate` DatabaseContextExpr
expr) Subschemas
subschemas
  
-- re-evaluate- it's not possible to display an incdep that may be for a foreign key to a relvar which is not available in the subschema! 
-- weird compromise: allow inclusion dependencies failures not in the subschema to be propagated- in the worst case, only the inclusion dependency's name is leaked.
  {-
-- | Convert inclusion dependencies for display in a specific schema.
applySchemaToInclusionDependencies :: Schema -> InclusionDependencies -> Either RelationalError InclusionDependencies
applySchemaToInclusionDependencies (Schema morphs) incDeps = 
  let incDepMorph incDep = --check that the mentioned relvars are in fact in the current schema
  M.update incDepMorph incDeps        
  -}

-- | Morph a relational expression in one schema to another isomorphic schema.
-- Returns a function which can be used to morph a 'GraphRefRelationalExpr'. Here, we naively apply the morphs in the current context ignoring past contexts because:
-- * the current schema may not exist in past
-- * this function should only be used for showing DDL, not for expression evaluation.
-- * if a schema were renamed, then the path to past isomorphisms in the transaction graph tree would be lost.
relExprMorph :: SchemaIsomorph -> RelationalExpr -> Either RelationalError RelationalExpr
relExprMorph :: SchemaIsomorph
-> RelationalExpr -> Either RelationalError RelationalExpr
relExprMorph (IsoRestrict RelVarName
relIn RestrictionPredicateExpr
_ (RelVarName
relOutTrue, RelVarName
relOutFalse)) = \case
  RelationVariable RelVarName
rv ()
m | RelVarName
rv RelVarName -> RelVarName -> Bool
forall a. Eq a => a -> a -> Bool
== RelVarName
relIn -> RelationalExpr -> Either RelationalError RelationalExpr
forall a b. b -> Either a b
Right (RelationalExpr -> RelationalExpr -> RelationalExpr
forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Union (RelVarName -> () -> RelationalExpr
forall a. RelVarName -> a -> RelationalExprBase a
RelationVariable RelVarName
relOutTrue ()
m) (RelVarName -> () -> RelationalExpr
forall a. RelVarName -> a -> RelationalExprBase a
RelationVariable RelVarName
relOutFalse ()
m))
  RelationalExpr
orig -> RelationalExpr -> Either RelationalError RelationalExpr
forall a b. b -> Either a b
Right RelationalExpr
orig
relExprMorph (IsoUnion (RelVarName
relInT, RelVarName
relInF) RestrictionPredicateExpr
predi RelVarName
relTarget) = \case
  --only the true predicate portion appears in the virtual schema  
  RelationVariable RelVarName
rv ()
m | RelVarName
rv RelVarName -> RelVarName -> Bool
forall a. Eq a => a -> a -> Bool
== RelVarName
relInT -> RelationalExpr -> Either RelationalError RelationalExpr
forall a b. b -> Either a b
Right (RestrictionPredicateExpr -> RelationalExpr -> RelationalExpr
forall a.
RestrictionPredicateExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Restrict RestrictionPredicateExpr
predi (RelVarName -> () -> RelationalExpr
forall a. RelVarName -> a -> RelationalExprBase a
RelationVariable RelVarName
relTarget ()
m))

  RelationVariable RelVarName
rv ()
m | RelVarName
rv RelVarName -> RelVarName -> Bool
forall a. Eq a => a -> a -> Bool
== RelVarName
relInF -> RelationalExpr -> Either RelationalError RelationalExpr
forall a b. b -> Either a b
Right (RestrictionPredicateExpr -> RelationalExpr -> RelationalExpr
forall a.
RestrictionPredicateExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Restrict (RestrictionPredicateExpr -> RestrictionPredicateExpr
forall a.
RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
NotPredicate RestrictionPredicateExpr
predi) (RelVarName -> () -> RelationalExpr
forall a. RelVarName -> a -> RelationalExprBase a
RelationVariable RelVarName
relTarget ()
m))
  RelationalExpr
orig -> RelationalExpr -> Either RelationalError RelationalExpr
forall a b. b -> Either a b
Right RelationalExpr
orig
relExprMorph (IsoRename RelVarName
relIn RelVarName
relOut) = \case
  RelationVariable RelVarName
rv ()
m | RelVarName
rv RelVarName -> RelVarName -> Bool
forall a. Eq a => a -> a -> Bool
== RelVarName
relIn -> RelationalExpr -> Either RelationalError RelationalExpr
forall a b. b -> Either a b
Right (RelVarName -> () -> RelationalExpr
forall a. RelVarName -> a -> RelationalExprBase a
RelationVariable RelVarName
relOut ()
m)
  RelationalExpr
orig -> RelationalExpr -> Either RelationalError RelationalExpr
forall a b. b -> Either a b
Right RelationalExpr
orig
  
relExprMogrify :: (RelationalExprBase a -> Either RelationalError (RelationalExprBase a)) -> RelationalExprBase a -> Either RelationalError (RelationalExprBase a)
relExprMogrify :: (RelationalExprBase a
 -> Either RelationalError (RelationalExprBase a))
-> RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
relExprMogrify RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func (Project AttributeNamesBase a
attrs RelationalExprBase a
expr) = RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func RelationalExprBase a
expr Either RelationalError (RelationalExprBase a)
-> (RelationalExprBase a
    -> Either RelationalError (RelationalExprBase a))
-> Either RelationalError (RelationalExprBase a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \RelationalExprBase a
ex -> RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func (AttributeNamesBase a
-> RelationalExprBase a -> RelationalExprBase a
forall a.
AttributeNamesBase a
-> RelationalExprBase a -> RelationalExprBase a
Project AttributeNamesBase a
attrs RelationalExprBase a
ex)
relExprMogrify RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func (Union RelationalExprBase a
exprA RelationalExprBase a
exprB) = do
  RelationalExprBase a
exA <- RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func RelationalExprBase a
exprA
  RelationalExprBase a
exB <- RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func RelationalExprBase a
exprB
  RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func (RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Union RelationalExprBase a
exA RelationalExprBase a
exB)
relExprMogrify RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func (Join RelationalExprBase a
exprA RelationalExprBase a
exprB) = do
  RelationalExprBase a
exA <- RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func RelationalExprBase a
exprA
  RelationalExprBase a
exB <- RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func RelationalExprBase a
exprB
  RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func (RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Join RelationalExprBase a
exA RelationalExprBase a
exB)
relExprMogrify RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func (Rename RelVarName
n1 RelVarName
n2 RelationalExprBase a
expr) = RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func RelationalExprBase a
expr Either RelationalError (RelationalExprBase a)
-> (RelationalExprBase a
    -> Either RelationalError (RelationalExprBase a))
-> Either RelationalError (RelationalExprBase a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \RelationalExprBase a
ex -> RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func (RelVarName
-> RelVarName -> RelationalExprBase a -> RelationalExprBase a
forall a.
RelVarName
-> RelVarName -> RelationalExprBase a -> RelationalExprBase a
Rename RelVarName
n1 RelVarName
n2 RelationalExprBase a
ex)
relExprMogrify RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func (Difference RelationalExprBase a
exprA RelationalExprBase a
exprB) = do
  RelationalExprBase a
exA <- RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func RelationalExprBase a
exprA
  RelationalExprBase a
exB <- RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func RelationalExprBase a
exprB
  RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func (RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Difference RelationalExprBase a
exA RelationalExprBase a
exB)
relExprMogrify RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func (Group AttributeNamesBase a
ns RelVarName
n RelationalExprBase a
expr) = RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func RelationalExprBase a
expr Either RelationalError (RelationalExprBase a)
-> (RelationalExprBase a
    -> Either RelationalError (RelationalExprBase a))
-> Either RelationalError (RelationalExprBase a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \RelationalExprBase a
ex -> RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func (AttributeNamesBase a
-> RelVarName -> RelationalExprBase a -> RelationalExprBase a
forall a.
AttributeNamesBase a
-> RelVarName -> RelationalExprBase a -> RelationalExprBase a
Group AttributeNamesBase a
ns RelVarName
n RelationalExprBase a
ex)
relExprMogrify RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func (Ungroup RelVarName
n RelationalExprBase a
expr) = RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func RelationalExprBase a
expr Either RelationalError (RelationalExprBase a)
-> (RelationalExprBase a
    -> Either RelationalError (RelationalExprBase a))
-> Either RelationalError (RelationalExprBase a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \RelationalExprBase a
ex -> RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func (RelVarName -> RelationalExprBase a -> RelationalExprBase a
forall a.
RelVarName -> RelationalExprBase a -> RelationalExprBase a
Ungroup RelVarName
n RelationalExprBase a
ex)
relExprMogrify RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func (Restrict RestrictionPredicateExprBase a
predi RelationalExprBase a
expr) = RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func RelationalExprBase a
expr Either RelationalError (RelationalExprBase a)
-> (RelationalExprBase a
    -> Either RelationalError (RelationalExprBase a))
-> Either RelationalError (RelationalExprBase a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \RelationalExprBase a
ex -> RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func (RestrictionPredicateExprBase a
-> RelationalExprBase a -> RelationalExprBase a
forall a.
RestrictionPredicateExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Restrict RestrictionPredicateExprBase a
predi RelationalExprBase a
ex)
relExprMogrify RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func (Equals RelationalExprBase a
exprA RelationalExprBase a
exprB) = do
  RelationalExprBase a
exA <- RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func RelationalExprBase a
exprA
  RelationalExprBase a
exB <- RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func RelationalExprBase a
exprB
  RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func (RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Equals RelationalExprBase a
exA RelationalExprBase a
exB)
relExprMogrify RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func (NotEquals RelationalExprBase a
exprA RelationalExprBase a
exprB) = do
  RelationalExprBase a
exA <- RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func RelationalExprBase a
exprA
  RelationalExprBase a
exB <- RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func RelationalExprBase a
exprB
  RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func (RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
NotEquals RelationalExprBase a
exA RelationalExprBase a
exB)
relExprMogrify RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func (Extend ExtendTupleExprBase a
ext RelationalExprBase a
expr) = RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func RelationalExprBase a
expr Either RelationalError (RelationalExprBase a)
-> (RelationalExprBase a
    -> Either RelationalError (RelationalExprBase a))
-> Either RelationalError (RelationalExprBase a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \RelationalExprBase a
ex -> RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func (ExtendTupleExprBase a
-> RelationalExprBase a -> RelationalExprBase a
forall a.
ExtendTupleExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Extend ExtendTupleExprBase a
ext RelationalExprBase a
ex)
relExprMogrify RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func RelationalExprBase a
other = RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
func RelationalExprBase a
other

{-
spam :: Either RelationalError RelationalExpr
spam = relExprMogrify (relExprMorph (IsoRestrict "emp" TruePredicate (Just "nonboss", Just "boss"))) (RelationVariable "emp" ())

spam2 :: Either RelationalError RelationalExpr
spam2 = relExprMogrify (relExprMorph (IsoUnion ("boss", Just "nonboss") TruePredicate "emp")) (RelationVariable "boss" ()) 
-}

databaseContextExprMorph :: SchemaIsomorph  -> (RelationalExpr -> Either RelationalError RelationalExpr) -> DatabaseContextExpr -> Either RelationalError DatabaseContextExpr
databaseContextExprMorph :: SchemaIsomorph
-> (RelationalExpr -> Either RelationalError RelationalExpr)
-> DatabaseContextExpr
-> Either RelationalError DatabaseContextExpr
databaseContextExprMorph iso :: SchemaIsomorph
iso@(IsoRestrict RelVarName
rvIn RestrictionPredicateExpr
filt (RelVarName
rvTrue, RelVarName
rvFalse)) RelationalExpr -> Either RelationalError RelationalExpr
relExprFunc DatabaseContextExpr
expr = case DatabaseContextExpr
expr of
  Assign RelVarName
rv RelationalExpr
relExpr | RelVarName
rv RelVarName -> RelVarName -> Bool
forall a. Eq a => a -> a -> Bool
== RelVarName
rvIn -> do
    RelationalExpr
ex <- RelationalExpr -> Either RelationalError RelationalExpr
relExprFunc RelationalExpr
relExpr
    let trueExpr :: RelVarName -> DatabaseContextExpr
trueExpr RelVarName
n = RelVarName -> RelationalExpr -> DatabaseContextExpr
forall a.
RelVarName -> RelationalExprBase a -> DatabaseContextExprBase a
Assign RelVarName
n (RestrictionPredicateExpr -> RelationalExpr -> RelationalExpr
forall a.
RestrictionPredicateExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Restrict RestrictionPredicateExpr
filt RelationalExpr
ex)
        falseExpr :: RelVarName -> DatabaseContextExpr
falseExpr RelVarName
n = RelVarName -> RelationalExpr -> DatabaseContextExpr
forall a.
RelVarName -> RelationalExprBase a -> DatabaseContextExprBase a
Assign RelVarName
n (RestrictionPredicateExpr -> RelationalExpr -> RelationalExpr
forall a.
RestrictionPredicateExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Restrict (RestrictionPredicateExpr -> RestrictionPredicateExpr
forall a.
RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
NotPredicate RestrictionPredicateExpr
filt) RelationalExpr
ex)
    DatabaseContextExpr -> Either RelationalError DatabaseContextExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DatabaseContextExpr -> Either RelationalError DatabaseContextExpr)
-> DatabaseContextExpr
-> Either RelationalError DatabaseContextExpr
forall a b. (a -> b) -> a -> b
$ [DatabaseContextExpr] -> DatabaseContextExpr
forall a. [DatabaseContextExprBase a] -> DatabaseContextExprBase a
MultipleExpr [RelVarName -> DatabaseContextExpr
trueExpr RelVarName
rvTrue, RelVarName -> DatabaseContextExpr
falseExpr RelVarName
rvFalse]
  Insert RelVarName
rv RelationalExpr
relExpr | RelVarName
rv RelVarName -> RelVarName -> Bool
forall a. Eq a => a -> a -> Bool
== RelVarName
rvIn -> do
    RelationalExpr
ex <- RelationalExpr -> Either RelationalError RelationalExpr
relExprFunc RelationalExpr
relExpr
    let trueExpr :: RelVarName -> DatabaseContextExpr
trueExpr RelVarName
n = RelVarName -> RelationalExpr -> DatabaseContextExpr
forall a.
RelVarName -> RelationalExprBase a -> DatabaseContextExprBase a
Insert RelVarName
n (RestrictionPredicateExpr -> RelationalExpr -> RelationalExpr
forall a.
RestrictionPredicateExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Restrict RestrictionPredicateExpr
filt RelationalExpr
ex)
        falseExpr :: RelVarName -> DatabaseContextExpr
falseExpr RelVarName
n = RelVarName -> RelationalExpr -> DatabaseContextExpr
forall a.
RelVarName -> RelationalExprBase a -> DatabaseContextExprBase a
Insert RelVarName
n (RestrictionPredicateExpr -> RelationalExpr -> RelationalExpr
forall a.
RestrictionPredicateExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Restrict (RestrictionPredicateExpr -> RestrictionPredicateExpr
forall a.
RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
NotPredicate RestrictionPredicateExpr
filt) RelationalExpr
ex)
    DatabaseContextExpr -> Either RelationalError DatabaseContextExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DatabaseContextExpr -> Either RelationalError DatabaseContextExpr)
-> DatabaseContextExpr
-> Either RelationalError DatabaseContextExpr
forall a b. (a -> b) -> a -> b
$ [DatabaseContextExpr] -> DatabaseContextExpr
forall a. [DatabaseContextExprBase a] -> DatabaseContextExprBase a
MultipleExpr [RelVarName -> DatabaseContextExpr
trueExpr RelVarName
rvTrue, RelVarName -> DatabaseContextExpr
falseExpr RelVarName
rvFalse]
  Update RelVarName
rv AttributeNameAtomExprMap
attrMap RestrictionPredicateExpr
predi | RelVarName
rv RelVarName -> RelVarName -> Bool
forall a. Eq a => a -> a -> Bool
== RelVarName
rvIn -> do
    -- if the update would "shift" a tuple from the true->false relvar or vice versa, that would be a constraint violation in the virtual schema
    let trueExpr :: RelVarName -> DatabaseContextExpr
trueExpr RelVarName
n = RelVarName
-> AttributeNameAtomExprMap
-> RestrictionPredicateExpr
-> DatabaseContextExpr
forall a.
RelVarName
-> AttributeNameAtomExprMap
-> RestrictionPredicateExprBase a
-> DatabaseContextExprBase a
Update RelVarName
n AttributeNameAtomExprMap
attrMap (RestrictionPredicateExpr
-> RestrictionPredicateExpr -> RestrictionPredicateExpr
forall a.
RestrictionPredicateExprBase a
-> RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
AndPredicate RestrictionPredicateExpr
predi RestrictionPredicateExpr
filt)
        falseExpr :: RelVarName -> DatabaseContextExpr
falseExpr RelVarName
n = RelVarName
-> AttributeNameAtomExprMap
-> RestrictionPredicateExpr
-> DatabaseContextExpr
forall a.
RelVarName
-> AttributeNameAtomExprMap
-> RestrictionPredicateExprBase a
-> DatabaseContextExprBase a
Update RelVarName
n AttributeNameAtomExprMap
attrMap (RestrictionPredicateExpr
-> RestrictionPredicateExpr -> RestrictionPredicateExpr
forall a.
RestrictionPredicateExprBase a
-> RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
AndPredicate RestrictionPredicateExpr
predi (RestrictionPredicateExpr -> RestrictionPredicateExpr
forall a.
RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
NotPredicate RestrictionPredicateExpr
filt))
    DatabaseContextExpr -> Either RelationalError DatabaseContextExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([DatabaseContextExpr] -> DatabaseContextExpr
forall a. [DatabaseContextExprBase a] -> DatabaseContextExprBase a
MultipleExpr [RelVarName -> DatabaseContextExpr
trueExpr RelVarName
rvTrue, RelVarName -> DatabaseContextExpr
falseExpr RelVarName
rvFalse])
  MultipleExpr [DatabaseContextExpr]
exprs -> [DatabaseContextExpr] -> DatabaseContextExpr
forall a. [DatabaseContextExprBase a] -> DatabaseContextExprBase a
MultipleExpr ([DatabaseContextExpr] -> DatabaseContextExpr)
-> Either RelationalError [DatabaseContextExpr]
-> Either RelationalError DatabaseContextExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DatabaseContextExpr -> Either RelationalError DatabaseContextExpr)
-> [DatabaseContextExpr]
-> Either RelationalError [DatabaseContextExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (SchemaIsomorph
-> (RelationalExpr -> Either RelationalError RelationalExpr)
-> DatabaseContextExpr
-> Either RelationalError DatabaseContextExpr
databaseContextExprMorph SchemaIsomorph
iso RelationalExpr -> Either RelationalError RelationalExpr
relExprFunc) [DatabaseContextExpr]
exprs
  DatabaseContextExpr
orig -> DatabaseContextExpr -> Either RelationalError DatabaseContextExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure DatabaseContextExpr
orig                                    
databaseContextExprMorph iso :: SchemaIsomorph
iso@(IsoUnion (RelVarName
rvTrue, RelVarName
rvFalse) RestrictionPredicateExpr
filt RelVarName
rvOut) RelationalExpr -> Either RelationalError RelationalExpr
relExprFunc DatabaseContextExpr
expr = case DatabaseContextExpr
expr of   
  --assign: replace all instances in the portion of the target relvar with the new tuples from the relExpr
  --problem: between the delete->insert, constraints could be violated which would not otherwise be violated in the "in" schema. This implies that there should be a combo operator which can insert/update/delete in a single pass based on relexpr queries, or perhaps MultipleExpr should be the infamous "comma" operator from TutorialD?
  -- if any tuples are filtered out of the insert/assign, we need to simulate a constraint violation
  Assign RelVarName
rv RelationalExpr
relExpr | RelVarName
rv RelVarName -> RelVarName -> Bool
forall a. Eq a => a -> a -> Bool
== RelVarName
rvTrue -> RelationalExpr -> Either RelationalError RelationalExpr
relExprFunc RelationalExpr
relExpr Either RelationalError RelationalExpr
-> (RelationalExpr -> Either RelationalError DatabaseContextExpr)
-> Either RelationalError DatabaseContextExpr
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \RelationalExpr
ex -> DatabaseContextExpr -> Either RelationalError DatabaseContextExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DatabaseContextExpr -> Either RelationalError DatabaseContextExpr)
-> DatabaseContextExpr
-> Either RelationalError DatabaseContextExpr
forall a b. (a -> b) -> a -> b
$ [DatabaseContextExpr] -> DatabaseContextExpr
forall a. [DatabaseContextExprBase a] -> DatabaseContextExprBase a
MultipleExpr [RelVarName -> RestrictionPredicateExpr -> DatabaseContextExpr
forall a.
RelVarName
-> RestrictionPredicateExprBase a -> DatabaseContextExprBase a
Delete RelVarName
rvOut RestrictionPredicateExpr
filt,
                                                                                      RelVarName -> RelationalExpr -> DatabaseContextExpr
forall a.
RelVarName -> RelationalExprBase a -> DatabaseContextExprBase a
Insert RelVarName
rvOut (RestrictionPredicateExpr -> RelationalExpr -> RelationalExpr
forall a.
RestrictionPredicateExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Restrict RestrictionPredicateExpr
filt RelationalExpr
ex)]
  Assign RelVarName
rv RelationalExpr
relExpr | RelVarName
rv RelVarName -> RelVarName -> Bool
forall a. Eq a => a -> a -> Bool
== RelVarName
rvFalse -> RelationalExpr -> Either RelationalError RelationalExpr
relExprFunc RelationalExpr
relExpr Either RelationalError RelationalExpr
-> (RelationalExpr -> Either RelationalError DatabaseContextExpr)
-> Either RelationalError DatabaseContextExpr
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \RelationalExpr
ex -> DatabaseContextExpr -> Either RelationalError DatabaseContextExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DatabaseContextExpr -> Either RelationalError DatabaseContextExpr)
-> DatabaseContextExpr
-> Either RelationalError DatabaseContextExpr
forall a b. (a -> b) -> a -> b
$ [DatabaseContextExpr] -> DatabaseContextExpr
forall a. [DatabaseContextExprBase a] -> DatabaseContextExprBase a
MultipleExpr [RelVarName -> RestrictionPredicateExpr -> DatabaseContextExpr
forall a.
RelVarName
-> RestrictionPredicateExprBase a -> DatabaseContextExprBase a
Delete RelVarName
rvOut (RestrictionPredicateExpr -> RestrictionPredicateExpr
forall a.
RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
NotPredicate RestrictionPredicateExpr
filt),            
                                                                                           RelVarName -> RelationalExpr -> DatabaseContextExpr
forall a.
RelVarName -> RelationalExprBase a -> DatabaseContextExprBase a
Insert RelVarName
rvOut (RestrictionPredicateExpr -> RelationalExpr -> RelationalExpr
forall a.
RestrictionPredicateExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Restrict (RestrictionPredicateExpr -> RestrictionPredicateExpr
forall a.
RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
NotPredicate RestrictionPredicateExpr
filt) RelationalExpr
ex)]
  Insert RelVarName
rv RelationalExpr
relExpr | RelVarName
rv RelVarName -> RelVarName -> Bool
forall a. Eq a => a -> a -> Bool
== RelVarName
rvTrue Bool -> Bool -> Bool
|| RelVarName
rv RelVarName -> RelVarName -> Bool
forall a. Eq a => a -> a -> Bool
== RelVarName
rvFalse -> RelationalExpr -> Either RelationalError RelationalExpr
relExprFunc RelationalExpr
relExpr Either RelationalError RelationalExpr
-> (RelationalExpr -> Either RelationalError DatabaseContextExpr)
-> Either RelationalError DatabaseContextExpr
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \RelationalExpr
ex -> DatabaseContextExpr -> Either RelationalError DatabaseContextExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DatabaseContextExpr -> Either RelationalError DatabaseContextExpr)
-> DatabaseContextExpr
-> Either RelationalError DatabaseContextExpr
forall a b. (a -> b) -> a -> b
$ RelVarName -> RelationalExpr -> DatabaseContextExpr
forall a.
RelVarName -> RelationalExprBase a -> DatabaseContextExprBase a
Insert RelVarName
rvOut RelationalExpr
ex
  Delete RelVarName
rv RestrictionPredicateExpr
delPred | RelVarName
rv RelVarName -> RelVarName -> Bool
forall a. Eq a => a -> a -> Bool
== RelVarName
rvTrue -> DatabaseContextExpr -> Either RelationalError DatabaseContextExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DatabaseContextExpr -> Either RelationalError DatabaseContextExpr)
-> DatabaseContextExpr
-> Either RelationalError DatabaseContextExpr
forall a b. (a -> b) -> a -> b
$ RelVarName -> RestrictionPredicateExpr -> DatabaseContextExpr
forall a.
RelVarName
-> RestrictionPredicateExprBase a -> DatabaseContextExprBase a
Delete RelVarName
rvOut (RestrictionPredicateExpr
-> RestrictionPredicateExpr -> RestrictionPredicateExpr
forall a.
RestrictionPredicateExprBase a
-> RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
AndPredicate RestrictionPredicateExpr
delPred RestrictionPredicateExpr
filt)
  Delete RelVarName
rv RestrictionPredicateExpr
delPred | RelVarName
rv RelVarName -> RelVarName -> Bool
forall a. Eq a => a -> a -> Bool
== RelVarName
rvFalse -> DatabaseContextExpr -> Either RelationalError DatabaseContextExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DatabaseContextExpr -> Either RelationalError DatabaseContextExpr)
-> DatabaseContextExpr
-> Either RelationalError DatabaseContextExpr
forall a b. (a -> b) -> a -> b
$ RelVarName -> RestrictionPredicateExpr -> DatabaseContextExpr
forall a.
RelVarName
-> RestrictionPredicateExprBase a -> DatabaseContextExprBase a
Delete RelVarName
rvOut (RestrictionPredicateExpr
-> RestrictionPredicateExpr -> RestrictionPredicateExpr
forall a.
RestrictionPredicateExprBase a
-> RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
AndPredicate RestrictionPredicateExpr
delPred (RestrictionPredicateExpr -> RestrictionPredicateExpr
forall a.
RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
NotPredicate RestrictionPredicateExpr
filt))
  Update RelVarName
rv AttributeNameAtomExprMap
attrMap RestrictionPredicateExpr
predi | RelVarName
rv RelVarName -> RelVarName -> Bool
forall a. Eq a => a -> a -> Bool
== RelVarName
rvTrue -> DatabaseContextExpr -> Either RelationalError DatabaseContextExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DatabaseContextExpr -> Either RelationalError DatabaseContextExpr)
-> DatabaseContextExpr
-> Either RelationalError DatabaseContextExpr
forall a b. (a -> b) -> a -> b
$ RelVarName
-> AttributeNameAtomExprMap
-> RestrictionPredicateExpr
-> DatabaseContextExpr
forall a.
RelVarName
-> AttributeNameAtomExprMap
-> RestrictionPredicateExprBase a
-> DatabaseContextExprBase a
Update RelVarName
rvOut AttributeNameAtomExprMap
attrMap (RestrictionPredicateExpr
-> RestrictionPredicateExpr -> RestrictionPredicateExpr
forall a.
RestrictionPredicateExprBase a
-> RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
AndPredicate RestrictionPredicateExpr
predi RestrictionPredicateExpr
filt)
  Update RelVarName
rv AttributeNameAtomExprMap
attrMap RestrictionPredicateExpr
predi | RelVarName
rv RelVarName -> RelVarName -> Bool
forall a. Eq a => a -> a -> Bool
== RelVarName
rvFalse -> DatabaseContextExpr -> Either RelationalError DatabaseContextExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DatabaseContextExpr -> Either RelationalError DatabaseContextExpr)
-> DatabaseContextExpr
-> Either RelationalError DatabaseContextExpr
forall a b. (a -> b) -> a -> b
$ RelVarName
-> AttributeNameAtomExprMap
-> RestrictionPredicateExpr
-> DatabaseContextExpr
forall a.
RelVarName
-> AttributeNameAtomExprMap
-> RestrictionPredicateExprBase a
-> DatabaseContextExprBase a
Update RelVarName
rvOut AttributeNameAtomExprMap
attrMap (RestrictionPredicateExpr
-> RestrictionPredicateExpr -> RestrictionPredicateExpr
forall a.
RestrictionPredicateExprBase a
-> RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
AndPredicate (RestrictionPredicateExpr -> RestrictionPredicateExpr
forall a.
RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
NotPredicate RestrictionPredicateExpr
filt) RestrictionPredicateExpr
predi)
  MultipleExpr [DatabaseContextExpr]
exprs -> [DatabaseContextExpr] -> DatabaseContextExpr
forall a. [DatabaseContextExprBase a] -> DatabaseContextExprBase a
MultipleExpr ([DatabaseContextExpr] -> DatabaseContextExpr)
-> Either RelationalError [DatabaseContextExpr]
-> Either RelationalError DatabaseContextExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DatabaseContextExpr -> Either RelationalError DatabaseContextExpr)
-> [DatabaseContextExpr]
-> Either RelationalError [DatabaseContextExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (SchemaIsomorph
-> (RelationalExpr -> Either RelationalError RelationalExpr)
-> DatabaseContextExpr
-> Either RelationalError DatabaseContextExpr
databaseContextExprMorph SchemaIsomorph
iso RelationalExpr -> Either RelationalError RelationalExpr
relExprFunc) [DatabaseContextExpr]
exprs
  DatabaseContextExpr
orig -> DatabaseContextExpr -> Either RelationalError DatabaseContextExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure DatabaseContextExpr
orig
databaseContextExprMorph iso :: SchemaIsomorph
iso@(IsoRename RelVarName
relIn RelVarName
relOut) RelationalExpr -> Either RelationalError RelationalExpr
relExprFunc DatabaseContextExpr
expr = case DatabaseContextExpr
expr of
  Assign RelVarName
rv RelationalExpr
relExpr | RelVarName
rv RelVarName -> RelVarName -> Bool
forall a. Eq a => a -> a -> Bool
== RelVarName
relIn -> RelationalExpr -> Either RelationalError RelationalExpr
relExprFunc RelationalExpr
relExpr Either RelationalError RelationalExpr
-> (RelationalExpr -> Either RelationalError DatabaseContextExpr)
-> Either RelationalError DatabaseContextExpr
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \RelationalExpr
ex -> DatabaseContextExpr -> Either RelationalError DatabaseContextExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelVarName -> RelationalExpr -> DatabaseContextExpr
forall a.
RelVarName -> RelationalExprBase a -> DatabaseContextExprBase a
Assign RelVarName
relOut RelationalExpr
ex)
  Insert RelVarName
rv RelationalExpr
relExpr | RelVarName
rv RelVarName -> RelVarName -> Bool
forall a. Eq a => a -> a -> Bool
== RelVarName
relIn -> RelationalExpr -> Either RelationalError RelationalExpr
relExprFunc RelationalExpr
relExpr Either RelationalError RelationalExpr
-> (RelationalExpr -> Either RelationalError DatabaseContextExpr)
-> Either RelationalError DatabaseContextExpr
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \RelationalExpr
ex -> DatabaseContextExpr -> Either RelationalError DatabaseContextExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DatabaseContextExpr -> Either RelationalError DatabaseContextExpr)
-> DatabaseContextExpr
-> Either RelationalError DatabaseContextExpr
forall a b. (a -> b) -> a -> b
$ RelVarName -> RelationalExpr -> DatabaseContextExpr
forall a.
RelVarName -> RelationalExprBase a -> DatabaseContextExprBase a
Insert RelVarName
relOut RelationalExpr
ex
  Delete RelVarName
rv RestrictionPredicateExpr
delPred | RelVarName
rv RelVarName -> RelVarName -> Bool
forall a. Eq a => a -> a -> Bool
== RelVarName
relIn -> DatabaseContextExpr -> Either RelationalError DatabaseContextExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DatabaseContextExpr -> Either RelationalError DatabaseContextExpr)
-> DatabaseContextExpr
-> Either RelationalError DatabaseContextExpr
forall a b. (a -> b) -> a -> b
$ RelVarName -> RestrictionPredicateExpr -> DatabaseContextExpr
forall a.
RelVarName
-> RestrictionPredicateExprBase a -> DatabaseContextExprBase a
Delete RelVarName
relOut RestrictionPredicateExpr
delPred
  Update RelVarName
rv AttributeNameAtomExprMap
attrMap RestrictionPredicateExpr
predi | RelVarName
rv RelVarName -> RelVarName -> Bool
forall a. Eq a => a -> a -> Bool
== RelVarName
relIn -> DatabaseContextExpr -> Either RelationalError DatabaseContextExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DatabaseContextExpr -> Either RelationalError DatabaseContextExpr)
-> DatabaseContextExpr
-> Either RelationalError DatabaseContextExpr
forall a b. (a -> b) -> a -> b
$ RelVarName
-> AttributeNameAtomExprMap
-> RestrictionPredicateExpr
-> DatabaseContextExpr
forall a.
RelVarName
-> AttributeNameAtomExprMap
-> RestrictionPredicateExprBase a
-> DatabaseContextExprBase a
Update RelVarName
relOut AttributeNameAtomExprMap
attrMap RestrictionPredicateExpr
predi
  MultipleExpr [DatabaseContextExpr]
exprs -> [DatabaseContextExpr] -> DatabaseContextExpr
forall a. [DatabaseContextExprBase a] -> DatabaseContextExprBase a
MultipleExpr ([DatabaseContextExpr] -> DatabaseContextExpr)
-> Either RelationalError [DatabaseContextExpr]
-> Either RelationalError DatabaseContextExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DatabaseContextExpr -> Either RelationalError DatabaseContextExpr)
-> [DatabaseContextExpr]
-> Either RelationalError [DatabaseContextExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (SchemaIsomorph
-> (RelationalExpr -> Either RelationalError RelationalExpr)
-> DatabaseContextExpr
-> Either RelationalError DatabaseContextExpr
databaseContextExprMorph SchemaIsomorph
iso RelationalExpr -> Either RelationalError RelationalExpr
relExprFunc) [DatabaseContextExpr]
exprs  
  DatabaseContextExpr
orig -> DatabaseContextExpr -> Either RelationalError DatabaseContextExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure DatabaseContextExpr
orig
  
-- | Apply the isomorphism transformations to the relational expression to convert the relational expression from operating on one schema to a disparate, isomorphic schema.
applyRelationalExprSchemaIsomorphs :: SchemaIsomorphs -> RelationalExpr -> Either RelationalError RelationalExpr
applyRelationalExprSchemaIsomorphs :: SchemaIsomorphs
-> RelationalExpr -> Either RelationalError RelationalExpr
applyRelationalExprSchemaIsomorphs SchemaIsomorphs
morphs RelationalExpr
expr = (RelationalExpr
 -> SchemaIsomorph -> Either RelationalError RelationalExpr)
-> RelationalExpr
-> SchemaIsomorphs
-> Either RelationalError RelationalExpr
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\RelationalExpr
expr' SchemaIsomorph
morph -> (RelationalExpr -> Either RelationalError RelationalExpr)
-> RelationalExpr -> Either RelationalError RelationalExpr
forall a.
(RelationalExprBase a
 -> Either RelationalError (RelationalExprBase a))
-> RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
relExprMogrify (SchemaIsomorph
-> RelationalExpr -> Either RelationalError RelationalExpr
relExprMorph SchemaIsomorph
morph) RelationalExpr
expr') RelationalExpr
expr SchemaIsomorphs
morphs

-- the morph must be applied in the opposite direction
--algorithm: create a relexpr for each relvar in the schema, then replace those rel exprs wherever they appear in the inc dep relexprs
-- x = x1 union x2
inclusionDependencyInSchema :: Schema -> InclusionDependency -> Either RelationalError InclusionDependency
inclusionDependencyInSchema :: Schema
-> InclusionDependency
-> Either RelationalError InclusionDependency
inclusionDependencyInSchema Schema
schema (InclusionDependency RelationalExpr
rexprA RelationalExpr
rexprB) = do
  --collect all relvars which appear in the schema
  let schemaRelVars :: Set RelVarName
schemaRelVars = SchemaIsomorphs -> Set RelVarName
isomorphsInRelVarNames (Schema -> SchemaIsomorphs
isomorphs Schema
schema)
  [(RelationalExpr, RelationalExpr)]
rvAssoc <- (RelVarName
 -> Either RelationalError (RelationalExpr, RelationalExpr))
-> [RelVarName]
-> Either RelationalError [(RelationalExpr, RelationalExpr)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\RelVarName
rvIn -> do 
                      RelationalExpr
rvOut <- Schema -> RelationalExpr -> Either RelationalError RelationalExpr
processRelationalExprInSchema Schema
schema (RelVarName -> () -> RelationalExpr
forall a. RelVarName -> a -> RelationalExprBase a
RelationVariable RelVarName
rvIn ())
                      (RelationalExpr, RelationalExpr)
-> Either RelationalError (RelationalExpr, RelationalExpr)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalExpr
rvOut, RelVarName -> () -> RelationalExpr
forall a. RelVarName -> a -> RelationalExprBase a
RelationVariable RelVarName
rvIn ())
                  )
             (Set RelVarName -> [RelVarName]
forall a. Set a -> [a]
S.toList Set RelVarName
schemaRelVars)
  let replacer :: RelationalExpr -> m RelationalExpr
replacer RelationalExpr
exprOrig = (RelationalExpr
 -> (RelationalExpr, RelationalExpr) -> m RelationalExpr)
-> RelationalExpr
-> [(RelationalExpr, RelationalExpr)]
-> m RelationalExpr
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\RelationalExpr
expr (RelationalExpr
find, RelationalExpr
replace) -> if RelationalExpr
expr RelationalExpr -> RelationalExpr -> Bool
forall a. Eq a => a -> a -> Bool
== RelationalExpr
find then
                                                            RelationalExpr -> m RelationalExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure RelationalExpr
replace
                                                          else
                                                            RelationalExpr -> m RelationalExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure RelationalExpr
expr) RelationalExpr
exprOrig [(RelationalExpr, RelationalExpr)]
rvAssoc
  RelationalExpr
rexprA' <- (RelationalExpr -> Either RelationalError RelationalExpr)
-> RelationalExpr -> Either RelationalError RelationalExpr
forall a.
(RelationalExprBase a
 -> Either RelationalError (RelationalExprBase a))
-> RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
relExprMogrify RelationalExpr -> Either RelationalError RelationalExpr
forall (m :: * -> *). Monad m => RelationalExpr -> m RelationalExpr
replacer RelationalExpr
rexprA
  RelationalExpr
rexprB' <- (RelationalExpr -> Either RelationalError RelationalExpr)
-> RelationalExpr -> Either RelationalError RelationalExpr
forall a.
(RelationalExprBase a
 -> Either RelationalError (RelationalExprBase a))
-> RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
relExprMogrify RelationalExpr -> Either RelationalError RelationalExpr
forall (m :: * -> *). Monad m => RelationalExpr -> m RelationalExpr
replacer RelationalExpr
rexprB
  InclusionDependency -> Either RelationalError InclusionDependency
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalExpr -> RelationalExpr -> InclusionDependency
InclusionDependency RelationalExpr
rexprA' RelationalExpr
rexprB')

-- #55 add two virtual constraints for IsoUnion and enforce them before the tuples disappear
-- this is needed to
-- also, it's inverse to IsoRestrict which adds two constraints at the base level
-- for IsoRestrict, consider hiding the two, generated constraints since they can never be thrown in the isomorphic schema
inclusionDependenciesInSchema :: Schema -> InclusionDependencies -> Either RelationalError InclusionDependencies
inclusionDependenciesInSchema :: Schema
-> InclusionDependencies
-> Either RelationalError InclusionDependencies
inclusionDependenciesInSchema Schema
schema InclusionDependencies
incDeps = [(RelVarName, InclusionDependency)] -> InclusionDependencies
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(RelVarName, InclusionDependency)] -> InclusionDependencies)
-> Either RelationalError [(RelVarName, InclusionDependency)]
-> Either RelationalError InclusionDependencies
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((RelVarName, InclusionDependency)
 -> Either RelationalError (RelVarName, InclusionDependency))
-> [(RelVarName, InclusionDependency)]
-> Either RelationalError [(RelVarName, InclusionDependency)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(RelVarName
depName, InclusionDependency
dep) -> Schema
-> InclusionDependency
-> Either RelationalError InclusionDependency
inclusionDependencyInSchema Schema
schema InclusionDependency
dep Either RelationalError InclusionDependency
-> (InclusionDependency
    -> Either RelationalError (RelVarName, InclusionDependency))
-> Either RelationalError (RelVarName, InclusionDependency)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \InclusionDependency
newDep -> (RelVarName, InclusionDependency)
-> Either RelationalError (RelVarName, InclusionDependency)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelVarName
depName, InclusionDependency
newDep)) (InclusionDependencies -> [(RelVarName, InclusionDependency)]
forall k a. Map k a -> [(k, a)]
M.toList InclusionDependencies
incDeps)
  
relationVariablesInSchema :: Schema -> Either RelationalError RelationVariables
relationVariablesInSchema :: Schema
-> Either RelationalError (Map RelVarName GraphRefRelationalExpr)
relationVariablesInSchema schema :: Schema
schema@(Schema SchemaIsomorphs
morphs) = (Map RelVarName GraphRefRelationalExpr
 -> SchemaIsomorph
 -> Either RelationalError (Map RelVarName GraphRefRelationalExpr))
-> Map RelVarName GraphRefRelationalExpr
-> SchemaIsomorphs
-> Either RelationalError (Map RelVarName GraphRefRelationalExpr)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Map RelVarName GraphRefRelationalExpr
-> SchemaIsomorph
-> Either RelationalError (Map RelVarName GraphRefRelationalExpr)
transform Map RelVarName GraphRefRelationalExpr
forall k a. Map k a
M.empty SchemaIsomorphs
morphs
  where
    transform :: Map RelVarName GraphRefRelationalExpr
-> SchemaIsomorph
-> Either RelationalError (Map RelVarName GraphRefRelationalExpr)
transform Map RelVarName GraphRefRelationalExpr
newRvMap SchemaIsomorph
morph = do
      let rvNames :: [RelVarName]
rvNames = SchemaIsomorph -> [RelVarName]
isomorphInRelVarNames SchemaIsomorph
morph
      [(RelVarName, GraphRefRelationalExpr)]
rvAssocs <- (RelVarName
 -> Either RelationalError (RelVarName, GraphRefRelationalExpr))
-> [RelVarName]
-> Either RelationalError [(RelVarName, GraphRefRelationalExpr)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\RelVarName
rv -> do
                           RelationalExpr
expr' <- Schema -> RelationalExpr -> Either RelationalError RelationalExpr
processRelationalExprInSchema Schema
schema (RelVarName -> () -> RelationalExpr
forall a. RelVarName -> a -> RelationalExprBase a
RelationVariable RelVarName
rv ())
                           let gfExpr :: GraphRefRelationalExpr
gfExpr = GraphRefTransactionMarker
-> ProcessExprM GraphRefRelationalExpr -> GraphRefRelationalExpr
forall a. GraphRefTransactionMarker -> ProcessExprM a -> a
runProcessExprM GraphRefTransactionMarker
UncommittedContextMarker (RelationalExpr -> ProcessExprM GraphRefRelationalExpr
processRelationalExpr RelationalExpr
expr')
                           (RelVarName, GraphRefRelationalExpr)
-> Either RelationalError (RelVarName, GraphRefRelationalExpr)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelVarName
rv, GraphRefRelationalExpr
gfExpr)) [RelVarName]
rvNames
      Map RelVarName GraphRefRelationalExpr
-> Either RelationalError (Map RelVarName GraphRefRelationalExpr)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map RelVarName GraphRefRelationalExpr
-> Map RelVarName GraphRefRelationalExpr
-> Map RelVarName GraphRefRelationalExpr
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Map RelVarName GraphRefRelationalExpr
newRvMap ([(RelVarName, GraphRefRelationalExpr)]
-> Map RelVarName GraphRefRelationalExpr
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(RelVarName, GraphRefRelationalExpr)]
rvAssocs))


-- | Show metadata about the relation variables in the isomorphic schema.
relationVariablesAsRelationInSchema :: DatabaseContext -> Schema -> TransactionGraph -> Either RelationalError Relation
relationVariablesAsRelationInSchema :: DatabaseContext
-> Schema -> TransactionGraph -> Either RelationalError Relation
relationVariablesAsRelationInSchema DatabaseContext
ctx (Schema []) TransactionGraph
graph = DatabaseContext
-> TransactionGraph -> Either RelationalError Relation
relationVariablesAsRelation DatabaseContext
ctx TransactionGraph
graph -- no schema morphism
relationVariablesAsRelationInSchema DatabaseContext
concreteDbContext Schema
schema TransactionGraph
graph = do
  Map RelVarName GraphRefRelationalExpr
rvDefsInConcreteSchema <- Schema
-> Either RelationalError (Map RelVarName GraphRefRelationalExpr)
relationVariablesInSchema Schema
schema
  let gfEnv :: GraphRefRelationalExprEnv
gfEnv = Maybe DatabaseContext
-> TransactionGraph -> GraphRefRelationalExprEnv
freshGraphRefRelationalExprEnv (DatabaseContext -> Maybe DatabaseContext
forall a. a -> Maybe a
Just DatabaseContext
concreteDbContext) TransactionGraph
graph
  [(RelVarName, Relation)]
typAssocs <- [(RelVarName, GraphRefRelationalExpr)]
-> ((RelVarName, GraphRefRelationalExpr)
    -> Either RelationalError (RelVarName, Relation))
-> Either RelationalError [(RelVarName, Relation)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Map RelVarName GraphRefRelationalExpr
-> [(RelVarName, GraphRefRelationalExpr)]
forall k a. Map k a -> [(k, a)]
M.toList Map RelVarName GraphRefRelationalExpr
rvDefsInConcreteSchema) (((RelVarName, GraphRefRelationalExpr)
  -> Either RelationalError (RelVarName, Relation))
 -> Either RelationalError [(RelVarName, Relation)])
-> ((RelVarName, GraphRefRelationalExpr)
    -> Either RelationalError (RelVarName, Relation))
-> Either RelationalError [(RelVarName, Relation)]
forall a b. (a -> b) -> a -> b
$ \(RelVarName
rv, GraphRefRelationalExpr
gfExpr) -> do
    Relation
typ <- GraphRefRelationalExprEnv
-> GraphRefRelationalExprM Relation
-> Either RelationalError Relation
forall a.
GraphRefRelationalExprEnv
-> GraphRefRelationalExprM a -> Either RelationalError a
runGraphRefRelationalExprM GraphRefRelationalExprEnv
gfEnv (GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
typeForGraphRefRelationalExpr GraphRefRelationalExpr
gfExpr)
    (RelVarName, Relation)
-> Either RelationalError (RelVarName, Relation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelVarName
rv, Relation
typ)
  let tups :: [[Atom]]
tups = ((RelVarName, Relation) -> [Atom])
-> [(RelVarName, Relation)] -> [[Atom]]
forall a b. (a -> b) -> [a] -> [b]
map (RelVarName, Relation) -> [Atom]
relVarToAtomList [(RelVarName, Relation)]
typAssocs
      subrelAttrs :: Attributes
subrelAttrs = [Attribute] -> Attributes
A.attributesFromList [RelVarName -> AtomType -> Attribute
Attribute RelVarName
"attribute" AtomType
TextAtomType, RelVarName -> AtomType -> Attribute
Attribute RelVarName
"type" AtomType
TextAtomType]
      attrs :: Attributes
attrs = [Attribute] -> Attributes
A.attributesFromList [RelVarName -> AtomType -> Attribute
Attribute RelVarName
"name" AtomType
TextAtomType,
                                  RelVarName -> AtomType -> Attribute
Attribute RelVarName
"attributes" (Attributes -> AtomType
RelationAtomType Attributes
subrelAttrs)]
      relVarToAtomList :: (RelVarName, Relation) -> [Atom]
relVarToAtomList (RelVarName
rvName, Relation
rel) = [RelVarName -> Atom
TextAtom RelVarName
rvName, Vector Attribute -> Atom
attributesToRel (Attributes -> Vector Attribute
attributesVec (Relation -> Attributes
attributes Relation
rel))]
      attrAtoms :: Attribute -> [Atom]
attrAtoms Attribute
a = [RelVarName -> Atom
TextAtom (Attribute -> RelVarName
A.attributeName Attribute
a), RelVarName -> Atom
TextAtom (AtomType -> RelVarName
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 -> String -> Atom
forall a. HasCallStack => String -> a
error (String
"relationVariablesAsRelation pooped " String -> ShowS
forall a. [a] -> [a] -> [a]
++ RelationalError -> String
forall a. Show a => a -> String
show RelationalError
err)
        Right Relation
rel -> Relation -> Atom
RelationAtom Relation
rel
  Attributes -> [[Atom]] -> Either RelationalError Relation
mkRelationFromList Attributes
attrs [[Atom]]
tups

{-
proposal
data DatabaseContext = 
Concrete ...|
Virtual Isomorphs
-}
{-  
applyRelationVariablesSchemaIsomorphs :: SchemaIsomorphs -> RelationVariables -> Either RelationalError RelationVariables                                                                 
applyRelationVariablesSchemaIsomorphs {-morphs rvs -}= undefined
-}
{-  M.fromList <$> mapM (\(rvname, rvexpr) -> do
                          morphed <- applyRelationalExprSchemaIsomorphs morphs rvexpr
                          pure (rvname, morphed)
                      ) (M.toList rvs)
  -}
{-
applySchemaIsomorphsToDatabaseContext :: SchemaIsomorphs -> DatabaseContext -> Either RelationalError DatabaseContext
applySchemaIsomorphsToDatabaseContext morphs context = do
--  incdeps <- inclusionDependen morphs (inclusionDependencies context)
  relvars <- applyRelationVariablesSchemaIsomorphs morphs (relationVariables context)
  pure (context { --inclusionDependencies = incdeps,
                  relationVariables = relvars
                  --atomFunctions = atomfuncs,
                  --notifications = notifs,
                  --typeConstructorMapping = tconsmapping
                })
  -}  
{-    
validate :: SchemaIsomorph -> S.Set RelVarName -> Either RelationalError SchemaIsomorph
validate morph underlyingRvNames = if S.size invalidRvNames > 0 then 
                          Left (MultipleErrors (map RelVarNotDefinedError (S.toList invalidRvNames)))
                         else
                           Right morph
  where
    morphRvNames = S.fromList (isomorphOutRelVarNames morph)
    invalidRvNames = S.difference morphRvNames underlyingRvNames
-}

-- | Create inclusion dependencies mainly for IsoRestrict because the predicate should hold in the base schema.
createIncDepsForIsomorph :: SchemaName -> SchemaIsomorph -> InclusionDependencies
createIncDepsForIsomorph :: RelVarName -> SchemaIsomorph -> InclusionDependencies
createIncDepsForIsomorph RelVarName
sname (IsoRestrict RelVarName
origRv RestrictionPredicateExpr
predi (RelVarName
rvTrue, RelVarName
rvFalse)) = let 
  newIncDep :: RestrictionPredicateExpr -> RelVarName -> InclusionDependency
newIncDep RestrictionPredicateExpr
predicate RelVarName
rv = RelationalExpr -> RelationalExpr -> InclusionDependency
InclusionDependency (AttributeNamesBase () -> RelationalExpr -> RelationalExpr
forall a.
AttributeNamesBase a
-> RelationalExprBase a -> RelationalExprBase a
Project AttributeNamesBase ()
forall a. AttributeNamesBase a
AN.empty (RestrictionPredicateExpr -> RelationalExpr -> RelationalExpr
forall a.
RestrictionPredicateExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Restrict RestrictionPredicateExpr
predicate (RelVarName -> () -> RelationalExpr
forall a. RelVarName -> a -> RelationalExprBase a
RelationVariable RelVarName
rv ()))) (Relation -> RelationalExpr
forall a. Relation -> RelationalExprBase a
ExistingRelation Relation
relationTrue)
  incDepName :: RelVarName -> RelVarName
incDepName RelVarName
b = RelVarName
"schema" RelVarName -> RelVarName -> RelVarName
forall a. Semigroup a => a -> a -> a
<> RelVarName
"_" RelVarName -> RelVarName -> RelVarName
forall a. Semigroup a => a -> a -> a
<> RelVarName
sname RelVarName -> RelVarName -> RelVarName
forall a. Semigroup a => a -> a -> a
<> RelVarName
"_" RelVarName -> RelVarName -> RelVarName
forall a. Semigroup a => a -> a -> a
<> RelVarName
b in
  [(RelVarName, InclusionDependency)] -> InclusionDependencies
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(RelVarName -> RelVarName
incDepName (RelVarName
origRv RelVarName -> RelVarName -> RelVarName
forall a. Semigroup a => a -> a -> a
<> RelVarName
"_true"), RestrictionPredicateExpr -> RelVarName -> InclusionDependency
newIncDep RestrictionPredicateExpr
predi RelVarName
rvTrue),
              (RelVarName -> RelVarName
incDepName (RelVarName
origRv RelVarName -> RelVarName -> RelVarName
forall a. Semigroup a => a -> a -> a
<> RelVarName
"_false"), RestrictionPredicateExpr -> RelVarName -> InclusionDependency
newIncDep (RestrictionPredicateExpr -> RestrictionPredicateExpr
forall a.
RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
NotPredicate RestrictionPredicateExpr
predi) RelVarName
rvFalse)]
createIncDepsForIsomorph RelVarName
_ SchemaIsomorph
_ = InclusionDependencies
forall k a. Map k a
M.empty

-- in the case of IsoRestrict, the database context should be updated with the restriction so that if the restriction does not hold, then the schema cannot be created
evalSchemaExpr :: SchemaExpr -> DatabaseContext -> TransactionId -> TransactionGraph -> Subschemas -> Either RelationalError (Subschemas, DatabaseContext)
evalSchemaExpr :: SchemaExpr
-> DatabaseContext
-> TransactionId
-> TransactionGraph
-> Subschemas
-> Either RelationalError (Subschemas, DatabaseContext)
evalSchemaExpr (AddSubschema RelVarName
sname SchemaIsomorphs
morphs) DatabaseContext
context TransactionId
transId TransactionGraph
graph Subschemas
sschemas =
  if RelVarName -> Subschemas -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member RelVarName
sname Subschemas
sschemas then
    RelationalError
-> Either RelationalError (Subschemas, DatabaseContext)
forall a b. a -> Either a b
Left (RelVarName -> RelationalError
SubschemaNameInUseError RelVarName
sname)
    else
    case Schema -> DatabaseContext -> Maybe SchemaError
validateSchema (SchemaIsomorphs -> Schema
Schema SchemaIsomorphs
morphs) DatabaseContext
context of
      Just SchemaError
err -> RelationalError
-> Either RelationalError (Subschemas, DatabaseContext)
forall a b. a -> Either a b
Left (SchemaError -> RelationalError
SchemaCreationError SchemaError
err)
      Maybe SchemaError
Nothing -> do
        let newSchemas :: Subschemas
newSchemas = RelVarName -> Schema -> Subschemas -> Subschemas
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert RelVarName
sname Schema
newSchema Subschemas
sschemas
            newSchema :: Schema
newSchema = SchemaIsomorphs -> Schema
Schema SchemaIsomorphs
morphs
            moreIncDeps :: InclusionDependencies
moreIncDeps = (SchemaIsomorph -> InclusionDependencies -> InclusionDependencies)
-> InclusionDependencies
-> SchemaIsomorphs
-> InclusionDependencies
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\SchemaIsomorph
morph InclusionDependencies
acc -> InclusionDependencies
-> InclusionDependencies -> InclusionDependencies
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union InclusionDependencies
acc (RelVarName -> SchemaIsomorph -> InclusionDependencies
createIncDepsForIsomorph RelVarName
sname SchemaIsomorph
morph)) InclusionDependencies
forall k a. Map k a
M.empty SchemaIsomorphs
morphs
            incDepExprs :: DatabaseContextExprBase a
incDepExprs = [DatabaseContextExprBase a] -> DatabaseContextExprBase a
forall a. [DatabaseContextExprBase a] -> DatabaseContextExprBase a
MultipleExpr (((RelVarName, InclusionDependency) -> DatabaseContextExprBase a)
-> [(RelVarName, InclusionDependency)]
-> [DatabaseContextExprBase a]
forall a b. (a -> b) -> [a] -> [b]
map ((RelVarName -> InclusionDependency -> DatabaseContextExprBase a)
-> (RelVarName, InclusionDependency) -> DatabaseContextExprBase a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry RelVarName -> InclusionDependency -> DatabaseContextExprBase a
forall a.
RelVarName -> InclusionDependency -> DatabaseContextExprBase a
AddInclusionDependency) (InclusionDependencies -> [(RelVarName, InclusionDependency)]
forall k a. Map k a -> [(k, a)]
M.toList InclusionDependencies
moreIncDeps))
            dbenv :: DatabaseContextEvalEnv
dbenv = TransactionId -> TransactionGraph -> DatabaseContextEvalEnv
mkDatabaseContextEvalEnv TransactionId
transId TransactionGraph
graph
        DatabaseContextEvalState
dbstate <- DatabaseContext
-> DatabaseContextEvalEnv
-> DatabaseContextEvalMonad ()
-> Either RelationalError DatabaseContextEvalState
runDatabaseContextEvalMonad DatabaseContext
context DatabaseContextEvalEnv
dbenv (GraphRefDatabaseContextExpr -> DatabaseContextEvalMonad ()
evalGraphRefDatabaseContextExpr GraphRefDatabaseContextExpr
forall a. DatabaseContextExprBase a
incDepExprs)
        (Subschemas, DatabaseContext)
-> Either RelationalError (Subschemas, DatabaseContext)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Subschemas
newSchemas, DatabaseContextEvalState -> DatabaseContext
dbc_context DatabaseContextEvalState
dbstate)
--need to propagate dirty flag here      

evalSchemaExpr (RemoveSubschema RelVarName
sname) DatabaseContext
context TransactionId
_ TransactionGraph
_ Subschemas
sschemas = if RelVarName -> Subschemas -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member RelVarName
sname Subschemas
sschemas then
                                           (Subschemas, DatabaseContext)
-> Either RelationalError (Subschemas, DatabaseContext)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelVarName -> Subschemas -> Subschemas
forall k a. Ord k => k -> Map k a -> Map k a
M.delete RelVarName
sname Subschemas
sschemas, DatabaseContext
context)
                                         else
                                           RelationalError
-> Either RelationalError (Subschemas, DatabaseContext)
forall a b. a -> Either a b
Left (RelVarName -> RelationalError
SubschemaNameNotInUseError RelVarName
sname)


-- | Apply SchemaIsomorphs to database context data.
class Morph a where
  morphToSchema :: Schema -> TransactionGraph -> a -> Either RelationalError a

instance Morph RelationalExpr where
  morphToSchema :: Schema
-> TransactionGraph
-> RelationalExpr
-> Either RelationalError RelationalExpr
morphToSchema Schema
schema TransactionGraph
_ RelationalExpr
relExprIn = do
      let processRelExpr :: RelationalExpr
-> SchemaIsomorph -> Either RelationalError RelationalExpr
processRelExpr RelationalExpr
rexpr SchemaIsomorph
morph = (RelationalExpr -> Either RelationalError RelationalExpr)
-> RelationalExpr -> Either RelationalError RelationalExpr
forall a.
(RelationalExprBase a
 -> Either RelationalError (RelationalExprBase a))
-> RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
relExprMogrify (SchemaIsomorph
-> RelationalExpr -> Either RelationalError RelationalExpr
relExprMorph SchemaIsomorph
morph) RelationalExpr
rexpr
      Schema -> RelationalExpr -> Either RelationalError ()
validateRelationalExprInSchema Schema
schema RelationalExpr
relExprIn                    
      (RelationalExpr
 -> SchemaIsomorph -> Either RelationalError RelationalExpr)
-> RelationalExpr
-> SchemaIsomorphs
-> Either RelationalError RelationalExpr
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM RelationalExpr
-> SchemaIsomorph -> Either RelationalError RelationalExpr
processRelExpr RelationalExpr
relExprIn (Schema -> SchemaIsomorphs
isomorphs Schema
schema)

-- | The names of inclusion dependencies might leak context about a different schema, but that's arbitrary and cannot be altered without having the user provide a renaming function or a new set of incDep names- seems extraneous.
instance Morph InclusionDependency where
  morphToSchema :: Schema
-> TransactionGraph
-> InclusionDependency
-> Either RelationalError InclusionDependency
morphToSchema Schema
schema TransactionGraph
_ (InclusionDependency RelationalExpr
rexprA RelationalExpr
rexprB) = do
    let schemaRelVars :: Set RelVarName
schemaRelVars = SchemaIsomorphs -> Set RelVarName
isomorphsInRelVarNames (Schema -> SchemaIsomorphs
isomorphs Schema
schema)
    [(RelationalExpr, RelationalExpr)]
rvAssoc <- (RelVarName
 -> Either RelationalError (RelationalExpr, RelationalExpr))
-> [RelVarName]
-> Either RelationalError [(RelationalExpr, RelationalExpr)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\RelVarName
rvIn -> do 
                      RelationalExpr
rvOut <- Schema -> RelationalExpr -> Either RelationalError RelationalExpr
processRelationalExprInSchema Schema
schema (RelVarName -> () -> RelationalExpr
forall a. RelVarName -> a -> RelationalExprBase a
RelationVariable RelVarName
rvIn ())
                      (RelationalExpr, RelationalExpr)
-> Either RelationalError (RelationalExpr, RelationalExpr)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalExpr
rvOut, RelVarName -> () -> RelationalExpr
forall a. RelVarName -> a -> RelationalExprBase a
RelationVariable RelVarName
rvIn ())
                  )
             (Set RelVarName -> [RelVarName]
forall a. Set a -> [a]
S.toList Set RelVarName
schemaRelVars)
    let replacer :: RelationalExpr -> m RelationalExpr
replacer RelationalExpr
exprOrig = (RelationalExpr
 -> (RelationalExpr, RelationalExpr) -> m RelationalExpr)
-> RelationalExpr
-> [(RelationalExpr, RelationalExpr)]
-> m RelationalExpr
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\RelationalExpr
expr (RelationalExpr
find, RelationalExpr
replace) -> if RelationalExpr
expr RelationalExpr -> RelationalExpr -> Bool
forall a. Eq a => a -> a -> Bool
== RelationalExpr
find then
                                                              RelationalExpr -> m RelationalExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure RelationalExpr
replace
                                                            else
                                                              RelationalExpr -> m RelationalExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure RelationalExpr
expr) RelationalExpr
exprOrig [(RelationalExpr, RelationalExpr)]
rvAssoc
    RelationalExpr
rexprA' <- (RelationalExpr -> Either RelationalError RelationalExpr)
-> RelationalExpr -> Either RelationalError RelationalExpr
forall a.
(RelationalExprBase a
 -> Either RelationalError (RelationalExprBase a))
-> RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
relExprMogrify RelationalExpr -> Either RelationalError RelationalExpr
forall (m :: * -> *). Monad m => RelationalExpr -> m RelationalExpr
replacer RelationalExpr
rexprA
    RelationalExpr
rexprB' <- (RelationalExpr -> Either RelationalError RelationalExpr)
-> RelationalExpr -> Either RelationalError RelationalExpr
forall a.
(RelationalExprBase a
 -> Either RelationalError (RelationalExprBase a))
-> RelationalExprBase a
-> Either RelationalError (RelationalExprBase a)
relExprMogrify RelationalExpr -> Either RelationalError RelationalExpr
forall (m :: * -> *). Monad m => RelationalExpr -> m RelationalExpr
replacer RelationalExpr
rexprB
    InclusionDependency -> Either RelationalError InclusionDependency
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalExpr -> RelationalExpr -> InclusionDependency
InclusionDependency RelationalExpr
rexprA' RelationalExpr
rexprB')

instance Morph InclusionDependencies where
  morphToSchema :: Schema
-> TransactionGraph
-> InclusionDependencies
-> Either RelationalError InclusionDependencies
morphToSchema Schema
schema TransactionGraph
tg InclusionDependencies
incDeps = [(RelVarName, InclusionDependency)] -> InclusionDependencies
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(RelVarName, InclusionDependency)] -> InclusionDependencies)
-> Either RelationalError [(RelVarName, InclusionDependency)]
-> Either RelationalError InclusionDependencies
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((RelVarName, InclusionDependency)
 -> Either RelationalError (RelVarName, InclusionDependency))
-> [(RelVarName, InclusionDependency)]
-> Either RelationalError [(RelVarName, InclusionDependency)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(RelVarName
n,InclusionDependency
incdep) -> (,) RelVarName
n (InclusionDependency -> (RelVarName, InclusionDependency))
-> Either RelationalError InclusionDependency
-> Either RelationalError (RelVarName, InclusionDependency)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Schema
-> TransactionGraph
-> InclusionDependency
-> Either RelationalError InclusionDependency
forall a.
Morph a =>
Schema -> TransactionGraph -> a -> Either RelationalError a
morphToSchema Schema
schema TransactionGraph
tg InclusionDependency
incdep) (InclusionDependencies -> [(RelVarName, InclusionDependency)]
forall k a. Map k a -> [(k, a)]
M.toList InclusionDependencies
incDeps)

{-
-- cannot be implemented because relvars map to transaction-graph-traversing expressions and we do not track schema changes over time
instance Morph RelationVariables where
  morphToSchema schema tg relVars = do
    let folder acc (IsoRename rvBase rvSchema) = 
          case M.lookup rvBase relVars of
            Nothing -> Left (RelVarNotDefinedError rvBase)
            Just gfExpr -> do
              gfExprSchema <- morphToSchema schema tg gfExpr
              pure (acc <> [(rvSchema, gfExprSchema)])
    M.fromList <$> foldM folder mempty (isomorphs schema)
-}
{-
instance Morph GraphRefRelationalExpr where
-- cannot be supported because we don't track how the schema changes over the lifetime of a transaction graph
-}