@@ -1,5 +1,5 @@
11{-# LANGUAGE OverloadedStrings #-}
2−module TutorialD.Interpreter.DatabaseExpr where
2+module TutorialD.Interpreter.DatabaseContextExpr where
33import Text.Parsec
44import Text.Parsec.String
55import ProjectM36.Base
@@ -15,7 +15,7 @@ import ProjectM36.RelationalExpression
1515import ProjectM36.Key
1616
1717--parsers which create "database expressions" which modify the database context (such as relvar assignment)
18−databaseExprP :: Parser DatabaseExpr
18+databaseExprP :: Parser DatabaseContextExpr
1919databaseExprP = choice $ map (\p -> p <* optional commentP) [insertP,
2020 deleteConstraintP,
2121 deleteP,
@@ -31,13 +31,13 @@ databaseExprP = choice $ map (\p -> p <* optional commentP) [insertP,
3131 removeTypeConstructorP,
3232 nothingP]
3333
34−commentP :: Parser DatabaseExpr
34+commentP :: Parser DatabaseContextExpr
3535commentP = reserved "--" >> manyTill anyChar eof >> pure NoOperation
3636
37−nothingP :: Parser DatabaseExpr
37+nothingP :: Parser DatabaseContextExpr
3838nothingP = whiteSpace >> pure NoOperation
3939
40−assignP :: Parser DatabaseExpr
40+assignP :: Parser DatabaseContextExpr
4141assignP = do
4242 relVarName <- try $ do
4343 relVarName <- identifier
@@ -46,19 +46,19 @@ assignP = do
4646 expr <- relExprP
4747 return $ Assign (T.pack relVarName) expr
4848
49−multipleDatabaseExprP :: Parser DatabaseExpr
50−multipleDatabaseExprP = do
49+multipleDatabaseContextExprP :: Parser DatabaseContextExpr
50+multipleDatabaseContextExprP = do
5151 exprs <- sepBy1 databaseExprP semi
5252 return $ MultipleExpr exprs
5353
54−insertP :: Parser DatabaseExpr
54+insertP :: Parser DatabaseContextExpr
5555insertP = do
5656 reservedOp "insert"
5757 relvar <- identifier
5858 expr <- relExprP
5959 return $ Insert (T.pack relvar) expr
6060
61−defineP :: Parser DatabaseExpr
61+defineP :: Parser DatabaseContextExpr
6262defineP = do
6363 relVarName <- try $ do
6464 relVarName <- identifier
@@ -67,20 +67,20 @@ defineP = do
6767 attributeSet <- makeAttributeExprsP
6868 return $ Define (T.pack relVarName) attributeSet
6969
70−undefineP :: Parser DatabaseExpr
70+undefineP :: Parser DatabaseContextExpr
7171undefineP = do
7272 reservedOp "undefine"
7373 relVarName <- identifier
7474 return $ Undefine (T.pack relVarName)
7575
76−deleteP :: Parser DatabaseExpr
76+deleteP :: Parser DatabaseContextExpr
7777deleteP = do
7878 reservedOp "delete"
7979 relVarName <- identifier
8080 predicate <- option TruePredicate (reservedOp "where" *> restrictionPredicateP)
8181 return $ Delete (T.pack relVarName) predicate
8282
83−updateP :: Parser DatabaseExpr
83+updateP :: Parser DatabaseContextExpr
8484updateP = do
8585 reservedOp "update"
8686 relVarName <- identifier
@@ -90,7 +90,7 @@ updateP = do
9090
9191data IncDepOp = SubsetOp | EqualityOp
9292
93−addConstraintP :: Parser DatabaseExpr
93+addConstraintP :: Parser DatabaseContextExpr
9494addConstraintP = do
9595 reservedOp "constraint" <|> reservedOp "foreign key"
9696 constraintName <- identifier
@@ -106,14 +106,14 @@ addConstraintP = do
106106
107107
108108
109−deleteConstraintP :: Parser DatabaseExpr
109+deleteConstraintP :: Parser DatabaseContextExpr
110110deleteConstraintP = do
111111 reserved "deleteconstraint"
112112 constraintName <- identifier
113113 return $ RemoveInclusionDependency (T.pack constraintName)
114114
115115-- key <constraint name> {<uniqueness attributes>} <uniqueness relexpr>
116−keyP :: Parser DatabaseExpr
116+keyP :: Parser DatabaseContextExpr
117117keyP = do
118118 reserved "key"
119119 keyName <- identifier
@@ -129,7 +129,7 @@ attributeAssignmentP = do
129129 atom <- stringAtomP <|> intAtomP
130130 return $ (attrName, atom)
131131
132−addNotificationP :: Parser DatabaseExpr
132+addNotificationP :: Parser DatabaseContextExpr
133133addNotificationP = do
134134 reserved "notify"
135135 notName <- identifier
@@ -137,14 +137,14 @@ addNotificationP = do
137137 resultExpr <- relExprP
138138 return $ AddNotification (T.pack notName) triggerExpr resultExpr
139139
140−removeNotificationP :: Parser DatabaseExpr
140+removeNotificationP :: Parser DatabaseContextExpr
141141removeNotificationP = do
142142 reserved "unnotify"
143143 notName <- identifier
144144 return $ RemoveNotification (T.pack notName)
145145
146146-- | data Hair = Bald | Color Text
147−addTypeConstructorP :: Parser DatabaseExpr
147+addTypeConstructorP :: Parser DatabaseContextExpr
148148addTypeConstructorP = do
149149 reserved "data"
150150 typeConstructorDef <- typeConstructorDefP
@@ -152,26 +152,26 @@ addTypeConstructorP = do
152152 dataConstructorDefs <- sepBy1 dataConstructorDefP pipe
153153 pure (AddTypeConstructor typeConstructorDef dataConstructorDefs)
154154
155−removeTypeConstructorP :: Parser DatabaseExpr
155+removeTypeConstructorP :: Parser DatabaseContextExpr
156156removeTypeConstructorP = do
157157 reserved "undata"
158158 RemoveTypeConstructor <$> liftM T.pack identifier
159159
160−databaseExprOpP :: Parser DatabaseExpr
161−databaseExprOpP = multipleDatabaseExprP
160+databaseExprOpP :: Parser DatabaseContextExpr
161+databaseExprOpP = multipleDatabaseContextExprP
162162
163−evalDatabaseExpr :: Bool -> DatabaseContext -> DatabaseExpr -> Either RelationalError DatabaseContext
164−evalDatabaseExpr useOptimizer context expr = do
163+evalDatabaseContextExpr :: Bool -> DatabaseContext -> DatabaseContextExpr -> Either RelationalError DatabaseContext
164+evalDatabaseContextExpr useOptimizer context expr = do
165165 optimizedExpr <- evalState (applyStaticDatabaseOptimization expr) context
166166 case runState (evalContextExpr (if useOptimizer then optimizedExpr else expr)) context of
167167 (Nothing, context') -> Right context'
168168 (Just err, _) -> Left err
169169
170170
171−interpretDatabaseExpr :: DatabaseContext -> String -> Either RelationalError DatabaseContext
172−interpretDatabaseExpr context tutdstring = case parse databaseExprOpP "" tutdstring of
171+interpretDatabaseContextExpr :: DatabaseContext -> String -> Either RelationalError DatabaseContext
172+interpretDatabaseContextExpr context tutdstring = case parse databaseExprOpP "" tutdstring of
173173 Left err -> Left $ ParseError (T.pack (show err))
174− Right parsed -> evalDatabaseExpr True context parsed
174+ Right parsed -> evalDatabaseContextExpr True context parsed
175175
176176{-
177177--no optimization