{-# 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
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
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
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
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]
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
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
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
()
_ <- Schema -> DatabaseContextExpr -> Either RelationalError ()
validateDatabaseContextExprInSchema Schema
schema DatabaseContextExpr
dbExpr
(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
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
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
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
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
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 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
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
inclusionDependencyInSchema :: Schema -> InclusionDependency -> Either RelationalError InclusionDependency
inclusionDependencyInSchema :: Schema
-> InclusionDependency
-> Either RelationalError InclusionDependency
inclusionDependencyInSchema Schema
schema (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')
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))
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
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
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
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)
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)
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)
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)