fbfd20c · project-m36 · git.iko.soy

git.iko.soy/project-m36

on master help sign in

WIP add inclusion dependency processing

fbfd20cAgentM12 years ago

RelationExpr.hs+44−3

compare with master

unifiedsplit

@@ -7,6 +7,7 @@ import RelationalError

7import qualified Data.Map as M

8import qualified Data.HashSet as HS

9import Control.Monad.State hiding (join)

10+import Data.Maybe

11--relvar state is needed in evaluation of relational expression but only as read-only in order to extract current relvar values

12--relvar state is needed in evaluation of relational expression but only as read-only in order to extract current relvar values

12evalRelationalExpr :: RelationalExpr -> DatabaseState (Either RelationalError Relation)

13evalRelationalExpr :: RelationalExpr -> DatabaseState (Either RelationalError Relation)

@@ -144,8 +145,12 @@ setRelVar :: String -> Relation -> DatabaseState (Maybe RelationalError)

144setRelVar relVarName rel = do

145setRelVar relVarName rel = do

145 state <- get

146 state <- get

146 let newRelVars = M.insert relVarName rel $ relationVariables state

147 let newRelVars = M.insert relVarName rel $ relationVariables state

148+ case checkConstraints state of

149+ Just err -> return $ Just err

150+ Nothing -> do

147− put $ DatabaseContext (inclusionDependencies state) newRelVars

151+ put $ DatabaseContext (inclusionDependencies state) newRelVars

148− return Nothing

152+ return Nothing

153+

149

154

150evalContextExpr :: DatabaseExpr -> DatabaseState (Maybe RelationalError)

155evalContextExpr :: DatabaseExpr -> DatabaseState (Maybe RelationalError)

151evalContextExpr (Define relVarName attrs) = do

156evalContextExpr (Define relVarName attrs) = do

@@ -181,7 +186,11 @@ evalContextExpr (Delete relVarName) = do

181

186

182evalContextExpr (Update relVarName attrAssignments) = undefined

187evalContextExpr (Update relVarName attrAssignments) = undefined

183

188

184−evalContextExpr (AddInclusionDependency dep) = undefined

189+evalContextExpr (AddInclusionDependency dep) = do

190+ state <- get

191+ let newDeps = HS.insert dep (inclusionDependencies state)

192+ put $ DatabaseContext newDeps (relationVariables state)

193+ return Nothing

185

194

186evalContextExpr (MultipleExpr exprs) = do

195evalContextExpr (MultipleExpr exprs) = do

187 evald <- mapM evalContextExpr exprs

196 evald <- mapM evalContextExpr exprs

@@ -190,5 +199,37 @@ evalContextExpr (MultipleExpr exprs) = do

190-- restrict relvar to get affected tuples, update tuples, delete restriction from relvar, relvar = relvar union updated tuples

199-- restrict relvar to get affected tuples, update tuples, delete restriction from relvar, relvar = relvar union updated tuples

191--evalRelVarExpr (Update relVarName updateMap) = do

200--evalRelVarExpr (Update relVarName updateMap) = do

192

201

202+--run verification on all constraints

203+checkConstraints :: DatabaseContext -> Maybe RelationalError

204+checkConstraints context = case failures of

205+ [] -> Nothing

206+ l:ls -> Just l

207+ where

208+ failures = catMaybes $ map checkIncDep (HS.toList deps)

209+ deps = inclusionDependencies context

210+ eval expr = runState (evalRelationalExpr expr) context

211+ checkIncDep (InclusionDependency depName subsetExpr supersetExpr) = case evaldSub of

212+ Left err -> Just err

213+ Right relSub -> case evaldSub of

214+ Left err -> Just err

215+ Right relSuper -> case union relSub relSuper of

216+ Left err -> Just err

217+ Right resultRel -> case resultRel of

218+ False -> Just $ InclusionDependencyCheckError depName

219+ True -> Nothing

220+ where

221+ evaldSub = eval subsetExpr

222+ evaldSuper = eval supersetExpr

223+

224+checkConstraint :: InclusionDependency -> DatabaseState (Maybe RelationalError)

225+checkConstraint (InclusionDependency name subDep superDep) = do

226+ evalSub <- evalRelExpr subDep

227+ evalSuper <- evalRelExpr superDep

228+ result <- liftM2 union evalSub evalSuper

229+

230+

231+

232+

233+

193

234

194

235

RelationType.hs+4−1

@@ -58,10 +58,13 @@ data DatabaseContext = DatabaseContext {

58 relationVariables :: M.Map String Relation

59 } deriving (Show)

61−data InclusionDependency = InclusionDependency RelationalExpr RelationalExpr deriving (Show)

61+data InclusionDependency = InclusionDependency String RelationalExpr RelationalExpr deriving (Show)

63instance Hash.Hashable InclusionDependency where

64 hashWithSalt salt dep = Hash.hashWithSalt salt (show dep)

65+

66+instance Eq InclusionDependency where

67+ (==) (InclusionDependency nameA _ _) (InclusionDependency nameB _ _) = nameA == nameB

66--Database context expressions modify the database context while relational expressions do not

69--Database context expressions modify the database context while relational expressions do not

67data DatabaseExpr where

70data DatabaseExpr where

RelationalError.hs+1

@@ -11,6 +11,7 @@ data RelationalError = NoSuchAttributeNameError String

11 | RelVarNotDefinedError String

12 | RelVarAlreadyDefinedError String

13 | RelVarAssignmentTypeMismatchError

14+ | InclusionDependencyCheckError String

14 | ParseError String

15 | ParseError String

15 deriving (Show,Eq)

16 deriving (Show,Eq)

RelationalInclusionDependency.hs+2−7

@@ -1,10 +1,5 @@

1module RelationalInclusionDependency where

2import RelationalError

3+import RelationType

4+import Data.Maybe

4−--run verification on all constraints

5−checkConstraints :: DatabaseContext -> Maybe RelationalError

6−checkConstraints context = undefined

7−

8−checkConstraint :: DatabaseContext -> Constraint -> Maybe RelationalError

9−checkConstraint context constraint = undefined

10−

TutorialDInterpreter.hs+29−3

@@ -141,6 +141,7 @@ databaseExpr :: Parser DatabaseExpr

141databaseExpr = insertP

142 <|> deleteP

143 <|> updateP

144+ <|> constraintP

144 <|> try defineP

145 <|> try defineP

145 <|> try assignP

146 <|> try assignP

146

147

@@ -177,6 +178,15 @@ updateP = do

177 attributeAssignments <- liftM M.fromList $ parens (sepBy attributeAssignment comma)

178 attributeAssignments <- liftM M.fromList $ parens (sepBy attributeAssignment comma)

178 return $ Update relVarName attributeAssignments

179 return $ Update relVarName attributeAssignments

179

180

181+constraintP :: Parser DatabaseExpr

182+constraintP = do

183+ reservedOp "constraint"

184+ constraintName <- identifier

185+ subset <- relExpr

186+ reservedOp "in"

187+ superset <- relExpr

188+ return $ AddInclusionDependency (InclusionDependency constraintName subset superset)

189+

180attributeAssignment :: Parser (String, RelationalExpr)

190attributeAssignment :: Parser (String, RelationalExpr)

181attributeAssignment = do

191attributeAssignment = do

182 attrName <- identifier

192 attrName <- identifier

@@ -192,6 +202,7 @@ parseString str = case parse multipleDatabaseExpr "" str of

192data TutorialDOperator where

202data TutorialDOperator where

193 ShowRelation :: RelationalExpr -> TutorialDOperator

203 ShowRelation :: RelationalExpr -> TutorialDOperator

194 ShowRelationVariableType :: String -> TutorialDOperator

204 ShowRelationVariableType :: String -> TutorialDOperator

205+ ShowConstraint :: String -> TutorialDOperator

195 deriving (Show)

206 deriving (Show)

196

207

197typeP :: Parser TutorialDOperator

208typeP :: Parser TutorialDOperator

@@ -200,15 +211,22 @@ typeP = do

200 relVarName <- identifier

211 relVarName <- identifier

201 return $ ShowRelationVariableType relVarName

212 return $ ShowRelationVariableType relVarName

202

213

203−showP :: Parser TutorialDOperator

214+showRelP :: Parser TutorialDOperator

204−showP = do

215+showRelP = do

205 reservedOp ":s"

216 reservedOp ":s"

206 expr <- relExpr

217 expr <- relExpr

207 return $ ShowRelation expr

218 return $ ShowRelation expr

208

219

220+showConstraintsP :: Parser TutorialDOperator

221+showConstraintsP = do

222+ reservedOp ":c"

223+ constraintName <- option "" identifier

224+ return $ ShowConstraint constraintName

225+

209interpreterOps :: Parser TutorialDOperator

226interpreterOps :: Parser TutorialDOperator

210interpreterOps = typeP

227interpreterOps = typeP

211− <|> showP

228+ <|> showRelP

229+ <|> showConstraintsP

212

230

213showRelationAttributes :: Relation -> String

231showRelationAttributes :: Relation -> String

214showRelationAttributes rel = "{" ++ concat (L.intersperse ", " $ map showAttribute attrs) ++ "}"

232showRelationAttributes rel = "{" ++ concat (L.intersperse ", " $ map showAttribute attrs) ++ "}"

@@ -228,6 +246,14 @@ evalTutorialDOp context (ShowRelation expr) = do

228 case runState (evalRelationalExpr expr) context of

246 case runState (evalRelationalExpr expr) context of

229 (Left err, _) -> show err

247 (Left err, _) -> show err

230 (Right rel, _) -> showRelation rel

248 (Right rel, _) -> showRelation rel

249+

250+evalTutorialDOp context (ShowConstraint name) = do

251+ show filteredDeps

252+ where

253+ deps = inclusionDependencies context

254+ filteredDeps = case name of

255+ "" -> deps

256+ name -> HS.filter (\(InclusionDependency n _ _) -> n == name) deps

231

257

232example1 = "relA {a,b, c}"

258example1 = "relA {a,b, c}"

233example2 = "relA join relB"

259example2 = "relA join relB"