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

ca59541AgentM10 years ago

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

compare with master

unifiedsplit

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

42isoRestrictP :: Parser SchemaIsomorph

43isoRestrictP = do

44 reserved "isorestrict"

45− relVarIn <- quotedString

45+ relVarIn <- qrelVarP

46 relvarsOut <- isoRestrictOutRelVarsP

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

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

49+isoRestrictOutRelVarsP :: Parser (RelVarName, RelVarName)

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

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

52−maybeRelVarP :: Parser (Maybe RelVarName)

52+qrelVarP :: Parser RelVarName

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

53+qrelVarP = quotedString

55isoUnionP :: Parser SchemaIsomorph

56isoUnionP = do

57 reserved "isounion"

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

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

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

60+isoUnionInRelVarsP :: Parser (RelVarName, RelVarName)

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

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

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

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

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

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

272data Schema = Schema SchemaIsomorphs

273 deriving (Generic, Binary)

274

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.

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, Maybe RelVarName) RestrictionPredicateExpr RelVarName --maps two relvars to one relvar

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

277 -- IsoTypeConstructor in morphAttrExpr

278 deriving (Generic, Binary)

279

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

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

366schemaForSessionId session = do

367 let sname = schemaName session

368 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 :/ )

370 else

371 case M.lookup sname (subschemas session) of

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

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

506 --update filesystem database, if necessary

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

508 processPersistence strat newGraph

509− sendNotifications nodesToNotify notsToFire

509+ sendNotifications nodesToNotify notsToFire --TODO: schema mod

510 return Nothing

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

512

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

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

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

599 atomically $ do

600− eSession <- sessionForSessionId sessionId sessions

600+ eSession <- sessionAndSchema sessionId sessions

601 case eSession of

602− Left err -> pure $ Left err

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

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

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

604

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

606

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

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

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

610 atomically $ do

611− eSession <- sessionForSessionId sessionId sessions

611+ eSession <- sessionAndSchema sessionId sessions

612 case eSession of

613− Left err -> pure $ Left err

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

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

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

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

616

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

637 eSession <- sessionAndSchema sessionId sessions

638 case eSession of

639 Left err -> pure (Left err)

640+ Right (session, schema) -> do

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

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

641− Left err -> pure (Left err)

642+ Left err -> pure (Left err)

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

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

643

644

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

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

645

646

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

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

3import ProjectM36.Base

4import ProjectM36.Error

5import ProjectM36.RelationalExpression

6−import Data.Maybe

7import Control.Monad

6import Control.Monad

8import Control.Monad.State

7import Control.Monad.State

9import GHC.Generics

8import GHC.Generics

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

26 RemoveSubschema SchemaName

25 RemoveSubschema SchemaName

27 deriving (Generic, Binary)

26 deriving (Generic, Binary)

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−

34isomorphs :: Schema -> SchemaIsomorphs

28isomorphs :: Schema -> SchemaIsomorphs

35isomorphs (Schema i) = i

29isomorphs (Schema i) = i

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−

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

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

42invert :: SchemaIsomorph -> SchemaIsomorph

32invert :: SchemaIsomorph -> SchemaIsomorph

43invert (IsoRelVarName nameA nameB) = IsoRelVarName nameB nameA

33invert (IsoRelVarName nameA nameB) = IsoRelVarName nameB nameA

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

46isomorphInRelVarNames :: SchemaIsomorph -> [RelVarName]

36isomorphInRelVarNames :: SchemaIsomorph -> [RelVarName]

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

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

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

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

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

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

51isomorphsInRelVarNames :: SchemaIsomorphs -> S.Set RelVarName

41isomorphsInRelVarNames :: SchemaIsomorphs -> S.Set RelVarName

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

54 rvnames morph acc = acc ++ isomorphInRelVarNames morph

44 rvnames morph acc = acc ++ isomorphInRelVarNames morph

56isomorphOutRelVarNames :: SchemaIsomorph -> [RelVarName]

46isomorphOutRelVarNames :: SchemaIsomorph -> [RelVarName]

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

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

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

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

60isomorphsOutRelVarNames :: SchemaIsomorphs -> S.Set RelVarName

50isomorphsOutRelVarNames :: SchemaIsomorphs -> S.Set RelVarName

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

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

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

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

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

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

92+relExprMorph (IsoRestrict relIn _ (relOutTrue, relOutFalse)) = \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 ()))

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

111 orig -> Right orig

94 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

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

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

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

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

115

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

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

117 orig -> Right orig

100 orig -> Right orig

118

101

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

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

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

154-}

137-}

155

138

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

139databaseContextExprMorph :: 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

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

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

159 ex <- relExprFunc relExpr

142 ex <- relExprFunc relExpr

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

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

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

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

162− case split of

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

145+ 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)

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

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

168 ex <- relExprFunc relExpr

147 ex <- relExprFunc relExpr

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

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

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

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

171− case split of

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

150+ 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)

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

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

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

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

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

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

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

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

180− case split of

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

155+ 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)

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

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

186 orig -> pure orig

157 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

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

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

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

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

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

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

191 Insert rvOut (Restrict filt ex)]

162 Insert rvOut (Restrict filt ex)]

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

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

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

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

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

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

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

166 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))

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

168 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)

199 orig -> pure orig

170 orig -> pure orig

200

171

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

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

207

178

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

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

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

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

210−applyInclusionDependenciesSchemaIsoMorphs morphs incDeps = undefined

181+applyInclusionDependenciesSchemaIsoMorphs _ _ = undefined

211

182

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

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

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

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

214− pure (relationVariables context)

215− else

216− foldM transform M.empty morphs

217 where

185 where

218 transform newRvMap morph = do

186 transform newRvMap morph = do

219 let rvNames = isomorphInRelVarNames morph

187 let rvNames = isomorphInRelVarNames morph