ca59541 · project-m36 · git.iko.soy

git.iko.soy/project-m36

remove isomorphic subschema support- they cannot work with inclusion dependencies which invevitably span the whole schema with foreign keys

commitca5954199318e51eadbc4cd4cd70d9481a4b4930 authorAgentM <agentm@themactionfaction.com> dateFri 4 Nov 2016, 23:59 (10 years ago) parent0f9da75

4 files changed+40−71

compare with master

unifiedsplit

src/bin/TutorialD/Interpreter/SchemaOperator.hs+8−8 src/lib/ProjectM36/Base.hs+2−2 src/lib/ProjectM36/Client.hs+12−11 src/lib/ProjectM36/IsomorphicSchema.hs+18−50

src/bin/TutorialD/Interpreter/SchemaOperator.hs+8−8

@@ -42,23 +42,23 @@ schemaIsomorphP = isoRestrictP <|> isoUnionP

4242isoRestrictP :: Parser SchemaIsomorph

4343isoRestrictP = do

4444 reserved "isorestrict"

45− relVarIn <- quotedString

45+ relVarIn <- qrelVarP

4646 relvarsOut <- isoRestrictOutRelVarsP

4747 IsoRestrict <$> pure relVarIn <*> restrictionPredicateP <*> pure relvarsOut

4848

49−isoRestrictOutRelVarsP :: Parser (Maybe RelVarName, Maybe RelVarName)

50−isoRestrictOutRelVarsP = (,) <$> maybeRelVarP <*> maybeRelVarP

49+isoRestrictOutRelVarsP :: Parser (RelVarName, RelVarName)

50+isoRestrictOutRelVarsP = (,) <$> qrelVarP <*> qrelVarP

5151

52−maybeRelVarP :: Parser (Maybe RelVarName)

53−maybeRelVarP = (Just <$> quotedString) <|> (reserved "Nothing" >> pure Nothing)

52+qrelVarP :: Parser RelVarName

53+qrelVarP = quotedString

5454

5555isoUnionP :: Parser SchemaIsomorph

5656isoUnionP = do

5757 reserved "isounion"

58− IsoUnion <$> isoUnionInRelVarsP <*> restrictionPredicateP <*> quotedString

58+ IsoUnion <$> isoUnionInRelVarsP <*> restrictionPredicateP <*> qrelVarP

5959

60−isoUnionInRelVarsP :: Parser (RelVarName, Maybe RelVarName)

61−isoUnionInRelVarsP = (,) <$> quotedString <*> maybeRelVarP

60+isoUnionInRelVarsP :: Parser (RelVarName, RelVarName)

61+isoUnionInRelVarsP = (,) <$> qrelVarP <*> qrelVarP

6262

6363evalSchemaOperator :: SessionId -> Connection -> SchemaOperator -> IO (Maybe RelationalError)

6464evalSchemaOperator sessionId conn (ModifySchemaExpr expr) = executeSchemaExpr sessionId conn expr

src/lib/ProjectM36/Base.hs+2−2

@@ -272,8 +272,8 @@ data Schemas = Schemas DatabaseContext Subschemas

272272data Schema = Schema SchemaIsomorphs

273273 deriving (Generic, Binary)

274274

275−data SchemaIsomorph = IsoRestrict RelVarName RestrictionPredicateExpr (Maybe RelVarName, Maybe RelVarName) | --maps one relvar into two relvars (true, false), if the false name is Nothing, no relvar in schemaB is created. This is useful for renaming relation variables between schemas or hiding relvars altogether.

276− IsoUnion (RelVarName, Maybe RelVarName) RestrictionPredicateExpr RelVarName --maps two relvars to one relvar

275+data SchemaIsomorph = IsoRestrict RelVarName RestrictionPredicateExpr (RelVarName, RelVarName) | --maps one relvar into two relvars (true, false), if the false name is Nothing, no relvar in schemaB is created. This is useful for renaming relation variables between schemas or hiding relvars altogether.

276+ IsoUnion (RelVarName, RelVarName) RestrictionPredicateExpr RelVarName --maps two relvars to one relvar

277277 -- IsoTypeConstructor in morphAttrExpr

278278 deriving (Generic, Binary)

279279

src/lib/ProjectM36/Client.hs+12−11

@@ -366,7 +366,7 @@ schemaForSessionId :: Session -> STM (Either RelationalError Schema)

366366schemaForSessionId session = do

367367 let sname = schemaName session

368368 if sname == defaultSchemaName then

369− pure (Right (Schema [])) -- the main schema includes no transformations

369+ pure (Right (Schema [])) -- the main schema includes no transformations (but neither do empty schemas :/ )

370370 else

371371 case M.lookup sname (subschemas session) of

372372 Nothing -> pure (Left (SubschemaNameNotInUseError sname))

@@ -506,7 +506,7 @@ executeGraphExpr sessionId (InProcessConnection strat clientNodes sessions graph

506506 --update filesystem database, if necessary

507507 --this should really grab a lock at the beginning of the method to be threadsafe

508508 processPersistence strat newGraph

509− sendNotifications nodesToNotify notsToFire

509+ sendNotifications nodesToNotify notsToFire --TODO: schema mod

510510 return Nothing

511511executeGraphExpr sessionId conn@(RemoteProcessConnection _ _) graphExpr = remoteCall conn (ExecuteGraphExpr sessionId graphExpr)

512512

@@ -597,10 +597,10 @@ typeForRelationalExprSTM _ _ _ = error "typeForRelationalExprSTM called on non-l

597597inclusionDependencies :: SessionId -> Connection -> IO (Either RelationalError (M.Map IncDepName InclusionDependency))

598598inclusionDependencies sessionId (InProcessConnection _ _ sessions _ _) = do

599599 atomically $ do

600− eSession <- sessionForSessionId sessionId sessions

600+ eSession <- sessionAndSchema sessionId sessions

601601 case eSession of

602− Left err -> pure $ Left err

603− Right session -> pure $ Right (B.inclusionDependencies (Sess.concreteDatabaseContext session))

602+ Left err -> pure $ Left err --TODO: schema application

603+ Right (session, schema) -> pure $ Right (B.inclusionDependencies (Sess.concreteDatabaseContext session))

604604

605605inclusionDependencies sessionId conn@(RemoteProcessConnection _ _) = remoteCall conn (RetrieveInclusionDependencies sessionId)

606606

@@ -608,10 +608,10 @@ inclusionDependencies sessionId conn@(RemoteProcessConnection _ _) = remoteCall

608608planForDatabaseContextExpr :: SessionId -> Connection -> DatabaseContextExpr -> IO (Either RelationalError DatabaseContextExpr)

609609planForDatabaseContextExpr sessionId (InProcessConnection _ _ sessions _ _) dbExpr = do

610610 atomically $ do

611− eSession <- sessionForSessionId sessionId sessions

611+ eSession <- sessionAndSchema sessionId sessions

612612 case eSession of

613− Left err -> pure $ Left err

614− Right session -> pure $ evalState (applyStaticDatabaseOptimization dbExpr) (Sess.concreteDatabaseContext session)

613+ Left err -> pure $ Left err --TODO: schema application

614+ Right (session, schema) -> pure $ evalState (applyStaticDatabaseOptimization dbExpr) (Sess.concreteDatabaseContext session)

615615planForDatabaseContextExpr sessionId conn@(RemoteProcessConnection _ _) dbExpr = remoteCall conn (RetrievePlanForDatabaseContextExpr sessionId dbExpr)

616616

617617-- | Return a relation which represents the current state of the global transaction graph. The attributes are

@@ -637,9 +637,10 @@ relationVariablesAsRelation sessionId (InProcessConnection _ _ sessions _ _) = d

637637 eSession <- sessionAndSchema sessionId sessions

638638 case eSession of

639639 Left err -> pure (Left err)

640− Right (session, schema) -> case Schema.relationVariablesInSchema schema (Sess.concreteDatabaseContext session) of

641− Left err -> pure (Left err)

642− Right relvars -> pure $ R.relationVariablesAsRelation relvars

640+ Right (session, schema) -> do

641+ case Schema.relationVariablesInSchema schema (Sess.concreteDatabaseContext session) of

642+ Left err -> pure (Left err)

643+ Right relvars -> pure $ R.relationVariablesAsRelation relvars

643644

644645relationVariablesAsRelation sessionId conn@(RemoteProcessConnection _ _) = remoteCall conn (RetrieveRelationVariableSummary sessionId)

645646

src/lib/ProjectM36/IsomorphicSchema.hs+18−50

@@ -3,7 +3,6 @@ module ProjectM36.IsomorphicSchema where

33import ProjectM36.Base

44import ProjectM36.Error

55import ProjectM36.RelationalExpression

6−import Data.Maybe

76import Control.Monad

87import Control.Monad.State

98import GHC.Generics

@@ -26,18 +25,9 @@ data SchemaExpr = AddSubschema SchemaName |

2625 RemoveSubschema SchemaName

2726 deriving (Generic, Binary)

2827

29−-- | Return True iff the SchemaIsomorph is fully isomorphic in the sense that it does not represent an isomorphic sub-schema.

30−isFullyIsomorphic :: SchemaIsomorph -> Bool

31−isFullyIsomorphic (IsoRestrict _ _ (a, b)) = isJust a && isJust b

32−isFullyIsomorphic (IsoUnion (_, a) _ _) = isJust a

33−

3428isomorphs :: Schema -> SchemaIsomorphs

3529isomorphs (Schema i) = i

3630

37−-- | Convenience function which renames a relvar in schemaA to another name in schemaB.

38−isomorphRename :: RelVarName -> RelVarName -> SchemaIsomorph

39−isomorphRename nameA nameB = IsoRestrict nameA TruePredicate (Just nameB, Nothing)

40−

4131{- -- useful for transforming a concrete context into a virtual schema and vice versa

4232invert :: SchemaIsomorph -> SchemaIsomorph

4333invert (IsoRelVarName nameA nameB) = IsoRelVarName nameB nameA

@@ -45,7 +35,7 @@ invert (IsoRelVarName nameA nameB) = IsoRelVarName nameB nameA

4535

4636isomorphInRelVarNames :: SchemaIsomorph -> [RelVarName]

4737isomorphInRelVarNames (IsoRestrict rv _ _) = [rv]

48−isomorphInRelVarNames (IsoUnion (rvA, mRvB) _ _) = rvA : maybe [] (\x -> [x]) mRvB

38+isomorphInRelVarNames (IsoUnion (rvA, rvB) _ _) = [rvA, rvB]

4939

5040-- | Relation variables names represented in the virtual schema space. Useful for determining if a relvar name is valid in the schema.

5141isomorphsInRelVarNames :: SchemaIsomorphs -> S.Set RelVarName

@@ -54,7 +44,7 @@ isomorphsInRelVarNames morphs = S.fromList (foldr rvnames [] morphs)

5444 rvnames morph acc = acc ++ isomorphInRelVarNames morph

5545

5646isomorphOutRelVarNames :: SchemaIsomorph -> [RelVarName]

57−isomorphOutRelVarNames (IsoRestrict _ _ (mRvA, mRvB)) = catMaybes [mRvA, mRvB]

47+isomorphOutRelVarNames (IsoRestrict _ _ (rvA, rvB)) = [rvA, rvB]

5848isomorphOutRelVarNames (IsoUnion _ _ rvA) = [rvA]

5949

6050isomorphsOutRelVarNames :: SchemaIsomorphs -> S.Set RelVarName

@@ -99,21 +89,14 @@ applySchemaToInclusionDependencies (Schema morphs) incDeps =

9989

10090-- | Morph a relational expression in one schema to another isomorphic schema.

10191relExprMorph :: SchemaIsomorph -> (RelationalExpr -> Either RelationalError RelationalExpr)

102−relExprMorph (IsoRestrict relIn predi split) = \expr -> case expr of

103− RelationVariable rv () | rv == relIn -> case split of

104− -- hide the relvarname

105− (Nothing, Nothing) -> Left (RelVarNotDefinedError rv)

106− --simple relvar rename

107− (Just relOutTrue, Nothing) -> Right (Restrict predi (RelationVariable relOutTrue ()))

108− --rename but always empty relation- is this useful?

109− (Nothing, Just relOutFalse) -> Right (Restrict (NotPredicate predi) (RelationVariable relOutFalse ()))

110− (Just relOutTrue, Just relOutFalse) -> Right (Union (RelationVariable relOutTrue ()) (RelationVariable relOutFalse ()))

92+relExprMorph (IsoRestrict relIn _ (relOutTrue, relOutFalse)) = \expr -> case expr of

93+ RelationVariable rv () | rv == relIn -> Right (Union (RelationVariable relOutTrue ()) (RelationVariable relOutFalse ()))

11194 orig -> Right orig

112−relExprMorph (IsoUnion (relInT, mRelInF) predi relTarget) = \expr -> case expr of

95+relExprMorph (IsoUnion (relInT, relInF) predi relTarget) = \expr -> case expr of

11396 --only the true predicate portion appears in the virtual schema

11497 RelationVariable rv () | rv == relInT -> Right (Restrict predi (RelationVariable relTarget ()))

11598

116− RelationVariable rv () | Just rv == mRelInF -> Right (Restrict (NotPredicate predi) (RelationVariable relTarget ()))

99+ RelationVariable rv () | rv == relInF -> Right (Restrict (NotPredicate predi) (RelationVariable relTarget ()))

117100 orig -> Right orig

118101

119102relExprMogrify :: (RelationalExpr -> Either RelationalError RelationalExpr) -> RelationalExpr -> Either RelationalError RelationalExpr

@@ -154,48 +137,36 @@ spam2 = relExprMogrify (relExprMorph (IsoUnion ("boss", Just "nonboss") TruePred

154137-}

155138

156139databaseContextExprMorph :: SchemaIsomorph -> (RelationalExpr -> Either RelationalError RelationalExpr) -> DatabaseContextExpr -> Either RelationalError DatabaseContextExpr

157−databaseContextExprMorph iso@(IsoRestrict rvIn filt split) relExprFunc expr = case expr of

140+databaseContextExprMorph iso@(IsoRestrict rvIn filt (rvTrue, rvFalse)) relExprFunc expr = case expr of

158141 Assign rv relExpr | rv == rvIn -> do

159142 ex <- relExprFunc relExpr

160143 let trueExpr n = Assign n (Restrict filt ex)

161144 falseExpr n = Assign n (Restrict (NotPredicate filt) ex)

162− case split of

163− (Just rvTrue, Just rvFalse) -> pure $ MultipleExpr [trueExpr rvTrue, falseExpr rvFalse]

164− (Just rvTrue, Nothing) -> pure (trueExpr rvTrue)

165− (Nothing, Just rvFalse) -> pure (falseExpr rvFalse)

166− (Nothing, Nothing) -> Left (RelVarNotDefinedError rvIn)

145+ pure $ MultipleExpr [trueExpr rvTrue, falseExpr rvFalse]

167146 Insert rv relExpr | rv == rvIn -> do

168147 ex <- relExprFunc relExpr

169148 let trueExpr n = Insert n (Restrict filt ex)

170149 falseExpr n = Insert n (Restrict (NotPredicate filt) ex)

171− case split of

172− (Just rvTrue, Just rvFalse) -> pure $ MultipleExpr [trueExpr rvTrue, falseExpr rvFalse]

173− (Just rvTrue, Nothing) -> pure (trueExpr rvTrue)

174− (Nothing, Just rvFalse) -> pure (falseExpr rvFalse)

175− (Nothing, Nothing) -> Left (RelVarNotDefinedError rvIn)

150+ pure $ MultipleExpr [trueExpr rvTrue, falseExpr rvFalse]

176151 Update rv attrMap predi | rv == rvIn -> do

177152 -- 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

178153 let trueExpr n = Update n attrMap (AndPredicate predi filt)

179154 falseExpr n = Update n attrMap (AndPredicate predi (NotPredicate filt))

180− case split of

181− (Just rvTrue, Just rvFalse) -> pure (MultipleExpr [trueExpr rvTrue, falseExpr rvFalse])

182− (Just rvTrue, Nothing) -> pure (trueExpr rvTrue)

183− (Nothing, Just rvFalse) -> pure (falseExpr rvFalse)

184− (Nothing, Nothing) -> Left (RelVarNotDefinedError rvIn)

155+ pure (MultipleExpr [trueExpr rvTrue, falseExpr rvFalse])

185156 MultipleExpr exprs -> MultipleExpr <$> mapM (databaseContextExprMorph iso relExprFunc) exprs

186157 orig -> pure orig

187−databaseContextExprMorph iso@(IsoUnion (rvTrue, mRvFalse) filt rvOut) relExprFunc expr = case expr of

158+databaseContextExprMorph (IsoUnion (rvTrue, rvFalse) filt rvOut) relExprFunc expr = case expr of

188159 --assign: replace all instances in the portion of the target relvar with the new tuples from the relExpr

189160 --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?

190161 Assign rv relExpr | rv == rvTrue -> relExprFunc relExpr >>= \ex -> pure $ MultipleExpr [Delete rvOut filt,

191162 Insert rvOut (Restrict filt ex)]

192− Assign rv relExpr | Just rv == mRvFalse -> relExprFunc relExpr >>= \ex -> pure $ MultipleExpr [Delete rvOut (NotPredicate filt),

193− Insert rvOut (Restrict (NotPredicate filt) ex)]

194− Insert rv relExpr | rv == rvTrue || Just rv == mRvFalse -> relExprFunc relExpr >>= \ex -> pure $ Insert rvOut ex

163+ Assign rv relExpr | rv == rvFalse -> relExprFunc relExpr >>= \ex -> pure $ MultipleExpr [Delete rvOut (NotPredicate filt),

164+ Insert rvOut (Restrict (NotPredicate filt) ex)]

165+ Insert rv relExpr | rv == rvTrue || rv == rvFalse -> relExprFunc relExpr >>= \ex -> pure $ Insert rvOut ex

195166 Delete rv delPred | rv == rvTrue -> pure $ Delete rvOut (AndPredicate delPred filt)

196− Delete rv delPred | Just rv == mRvFalse -> pure $ Delete rvOut (AndPredicate delPred (NotPredicate filt))

167+ Delete rv delPred | rv == rvFalse -> pure $ Delete rvOut (AndPredicate delPred (NotPredicate filt))

197168 Update rv attrMap predi | rv == rvTrue -> pure $ Update rvOut attrMap (AndPredicate predi filt)

198− Update rv attrMap predi | Just rv == mRvFalse -> pure $ Update rvOut attrMap (AndPredicate (NotPredicate filt) predi)

169+ Update rv attrMap predi | rv == rvFalse -> pure $ Update rvOut attrMap (AndPredicate (NotPredicate filt) predi)

199170 orig -> pure orig

200171

201172-- | Apply the isomorphism transformations to the relational expression to convert the relational expression from operating on one schema to a disparate, isomorphic schema.

@@ -207,13 +178,10 @@ inclusionDependenciesMorph iso = \(InclusionDependency subExpr expr) -> Inclusio

207178

208179applyInclusionDependenciesSchemaIsoMorphs :: SchemaIsomorphs -> InclusionDependencies -> Either RelationalError InclusionDependencies

209180--add inc deps for restriction with some automatic name

210−applyInclusionDependenciesSchemaIsoMorphs morphs incDeps = undefined

181+applyInclusionDependenciesSchemaIsoMorphs _ _ = undefined

211182

212183relationVariablesInSchema :: Schema -> DatabaseContext -> Either RelationalError RelationVariables

213−relationVariablesInSchema schema@(Schema morphs) context = if null morphs then --main schema

214− pure (relationVariables context)

215− else

216− foldM transform M.empty morphs

184+relationVariablesInSchema schema@(Schema morphs) context = foldM transform M.empty morphs

217185 where

218186 transform newRvMap morph = do

219187 let rvNames = isomorphInRelVarNames morph