fbfd20c · project-m36 · git.iko.soy

git.iko.soy/project-m36

WIP add inclusion dependency processing

commitfbfd20ca79a65686a6a72662c2c4c3679b845303 authorAgentM <agentm@themactionfaction.com> dateTue 25 Nov 2014, 09:30 (12 years ago) parentaf03e83

5 files changed+80−14

compare with master

unifiedsplit

RelationExpr.hs+44−3 RelationType.hs+4−1 RelationalError.hs+1 RelationalInclusionDependency.hs+2−7 TutorialDInterpreter.hs+29−3

RelationExpr.hs+44−3

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

77import qualified Data.Map as M

88import qualified Data.HashSet as HS

99import Control.Monad.State hiding (join)

10+import Data.Maybe

1011

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

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

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

144145setRelVar relVarName rel = do

145146 state <- get

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

147− put $ DatabaseContext (inclusionDependencies state) newRelVars

148− return Nothing

148+ case checkConstraints state of

149+ Just err -> return $ Just err

150+ Nothing -> do

151+ put $ DatabaseContext (inclusionDependencies state) newRelVars

152+ return Nothing

153+

149154

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

151156evalContextExpr (Define relVarName attrs) = do

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

181186

182187evalContextExpr (Update relVarName attrAssignments) = undefined

183188

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

185194

186195evalContextExpr (MultipleExpr exprs) = do

187196 evald <- mapM evalContextExpr exprs

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

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

191200--evalRelVarExpr (Update relVarName updateMap) = do

192201

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+

193234

194235

RelationType.hs+4−1

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

5858 relationVariables :: M.Map String Relation

5959 } deriving (Show)

6060

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

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

6262

6363instance Hash.Hashable InclusionDependency where

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

65+

66+instance Eq InclusionDependency where

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

6568

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

6770data DatabaseExpr where

RelationalError.hs+1

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

1111 | RelVarNotDefinedError String

1212 | RelVarAlreadyDefinedError String

1313 | RelVarAssignmentTypeMismatchError

14+ | InclusionDependencyCheckError String

1415 | ParseError String

1516 deriving (Show,Eq)

1617

RelationalInclusionDependency.hs+2−7

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

11module RelationalInclusionDependency where

22import 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

141141databaseExpr = insertP

142142 <|> deleteP

143143 <|> updateP

144+ <|> constraintP

144145 <|> try defineP

145146 <|> try assignP

146147

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

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

178179 return $ Update relVarName attributeAssignments

179180

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+

180190attributeAssignment :: Parser (String, RelationalExpr)

181191attributeAssignment = do

182192 attrName <- identifier

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

192202data TutorialDOperator where

193203 ShowRelation :: RelationalExpr -> TutorialDOperator

194204 ShowRelationVariableType :: String -> TutorialDOperator

205+ ShowConstraint :: String -> TutorialDOperator

195206 deriving (Show)

196207

197208typeP :: Parser TutorialDOperator

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

200211 relVarName <- identifier

201212 return $ ShowRelationVariableType relVarName

202213

203−showP :: Parser TutorialDOperator

204−showP = do

214+showRelP :: Parser TutorialDOperator

215+showRelP = do

205216 reservedOp ":s"

206217 expr <- relExpr

207218 return $ ShowRelation expr

208219

220+showConstraintsP :: Parser TutorialDOperator

221+showConstraintsP = do

222+ reservedOp ":c"

223+ constraintName <- option "" identifier

224+ return $ ShowConstraint constraintName

225+

209226interpreterOps :: Parser TutorialDOperator

210227interpreterOps = typeP

211− <|> showP

228+ <|> showRelP

229+ <|> showConstraintsP

212230

213231showRelationAttributes :: Relation -> String

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

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

228246 case runState (evalRelationalExpr expr) context of

229247 (Left err, _) -> show err

230248 (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

231257

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

233259example2 = "relA join relB"