@@ -17,7 +17,7 @@ import qualified Data.List as L
1717import Control.Applicative (liftA, (<*), (*>))
1818import Control.Monad.State
1919import System.Console.Readline
20−
20+import System.IO
2121
2222lexer :: Token.TokenParser ()
2323lexer = Token.makeTokenParser tutD
@@ -184,9 +184,9 @@ updateP :: Parser DatabaseExpr
184184updateP = do
185185 reservedOp "update"
186186 relVarName <- identifier
187− -- where clause
187+ predicate <- option TruePredicate (reservedOp "where" *> restrictionPredicateP <* spaces)
188188 attributeAssignments <- liftM M.fromList $ parens (sepBy attributeAssignment comma)
189− return $ Update relVarName attributeAssignments
189+ return $ Update relVarName attributeAssignments predicate
190190
191191constraintP :: Parser DatabaseExpr
192192constraintP = do
@@ -197,12 +197,12 @@ constraintP = do
197197 superset <- relExpr
198198 return $ AddInclusionDependency (InclusionDependency constraintName subset superset)
199199
200−attributeAssignment :: Parser (String, RelationalExpr)
200+attributeAssignment :: Parser (String, Atom)
201201attributeAssignment = do
202202 attrName <- identifier
203203 reservedOp ":="
204− relExpr <- relExpr
205− return $ (attrName, relExpr)
204+ atom <- stringAtomP <|> intAtomP
205+ return $ (attrName, atom)
206206
207207parseString :: String -> Either RelationalError DatabaseExpr
208208parseString str = case parse multipleDatabaseExpr "" str of
@@ -213,6 +213,7 @@ data TutorialDOperator where
213213 ShowRelation :: RelationalExpr -> TutorialDOperator
214214 ShowRelationType :: RelationalExpr -> TutorialDOperator
215215 ShowConstraint :: String -> TutorialDOperator
216+ Quit :: TutorialDOperator
216217 deriving (Show)
217218
218219typeP :: Parser TutorialDOperator
@@ -227,6 +228,11 @@ showRelP = do
227228 expr <- relExpr
228229 return $ ShowRelation expr
229230
231+quitP :: Parser TutorialDOperator
232+quitP = do
233+ reservedOp ":q"
234+ return Quit
235+
230236showConstraintsP :: Parser TutorialDOperator
231237showConstraintsP = do
232238 reservedOp ":c"
@@ -237,6 +243,7 @@ interpreterOps :: Parser TutorialDOperator
237243interpreterOps = typeP
238244 <|> showRelP
239245 <|> showConstraintsP
246+ <|> quitP
240247
241248showRelationAttributes :: Relation -> String
242249showRelationAttributes rel = "{" ++ concat (L.intersperse ", " $ map showAttribute attrs) ++ "}"
@@ -247,23 +254,30 @@ showRelationAttributes rel = "{" ++ concat (L.intersperse ", " $ map showAttribu
247254 attrs = values (attributes rel)
248255 values m = map snd (M.toAscList m)
249256
250−evalTutorialDOp :: DatabaseContext -> TutorialDOperator -> String
257+data TutorialDOperatorResult = QuitResult |
258+ DisplayResult String |
259+ DisplayErrorResult String |
260+ NoActionResult
261+
262+evalTutorialDOp :: DatabaseContext -> TutorialDOperator -> TutorialDOperatorResult
251263evalTutorialDOp context (ShowRelationType expr) = case runState (typeForRelationalExpr expr) context of
252− (Right rel, _) -> showRelationAttributes rel
253− (Left err, _) -> show err
264+ (Right rel, _) -> DisplayResult $ showRelationAttributes rel
265+ (Left err, _) -> DisplayErrorResult $ show err
254266
255267evalTutorialDOp context (ShowRelation expr) = do
256268 case runState (evalRelationalExpr expr) context of
257− (Left err, _) -> show err
258− (Right rel, _) -> showRelation rel
269+ (Left err, _) -> DisplayErrorResult $ show err
270+ (Right rel, _) -> DisplayResult $ showRelation rel
259271
260272evalTutorialDOp context (ShowConstraint name) = do
261− show filteredDeps
273+ DisplayResult $ show filteredDeps
262274 where
263275 deps = inclusionDependencies context
264276 filteredDeps = case name of
265277 "" -> deps
266278 name -> HS.filter (\(InclusionDependency n _ _) -> n == name) deps
279+
280+evalTutorialDOp context (Quit) = QuitResult
267281
268282example1 = "relA {a,b, c}"
269283example2 = "relA join relB"
@@ -281,10 +295,10 @@ interpret context tutdstring = case parseString tutdstring of
281295 Right parsed -> runState (evalContextExpr parsed) context
282296
283297-- for interpreter-specific operations
284−interpretOps :: DatabaseContext -> String -> Maybe String
298+interpretOps :: DatabaseContext -> String -> TutorialDOperatorResult
285299interpretOps context instring = case parse interpreterOps "" instring of
286− Left err -> Nothing
287− Right ops -> Just $ evalTutorialDOp context ops
300+ Left err -> NoActionResult
301+ Right ops -> evalTutorialDOp context ops
288302
289303reprLoop :: DatabaseContext -> IO ()
290304reprLoop context = do
@@ -295,28 +309,31 @@ reprLoop context = do
295309 addHistory line
296310
297311 case interpretOps context line of
298− Just out -> do
312+ QuitResult -> return ()
313+ DisplayErrorResult err -> hPutStrLn stderr ("ERR: " ++ err)
314+ DisplayResult out -> do
299315 putStrLn out
300316 reprLoop context
301− Nothing -> return ()
302−
303− let (value, contextup) = interpret context line
304− case value of
305− Nothing -> reprLoop contextup
306− (Just err) -> do
307− putStrLn $ show err
308− reprLoop context
317+ NoActionResult -> do
318+ let (value, contextup) = interpret context line
319+ case value of
320+ Nothing -> reprLoop contextup
321+ (Just err) -> do
322+ hPutStrLn stderr ("ERR:" ++ show err)
323+ reprLoop context
309324
310325restrictionPredicateP :: Parser RestrictionPredicateExpr
311326restrictionPredicateP = buildExpressionParser predicateOperators predicateTerm
312327 where
313328 predicateOperators = [
329+ [Prefix (reservedOp "not" >> return NotPredicate)],
314330 [Infix (reservedOp "and" >> return AndPredicate) AssocLeft],
315331 [Infix (reservedOp "or" >> return OrPredicate) AssocLeft]
316332 ]
317333 predicateTerm = parens restrictionPredicateP
318334 <|> try restrictionAttributeEqualityP
319− <|> relationalBooleanExpr
335+ <|> try relationalBooleanExpr
336+
320337
321338relationalBooleanExpr :: Parser RestrictionPredicateExpr
322339relationalBooleanExpr = do