@@ -14,7 +14,7 @@ import qualified Data.Set as S
1414import qualified Data.HashSet as HS
1515import qualified Data.Map as M
1616import qualified Data.List as L
17−import Control.Applicative (liftA)
17+import Control.Applicative (liftA, (<*), (*>))
1818import Control.Monad.State
1919import System.Console.Readline
2020
@@ -108,6 +108,11 @@ renameP = do
108108 (oldAttr, newAttr) <- braces renameClause
109109 return $ Rename oldAttr newAttr
110110
111+whereClauseP = do
112+ reservedOp "where"
113+ boolExpr <- restrictionPredicateP
114+ return $ Restrict boolExpr
115+
111116groupClause = do
112117 attrs <- braces attributeList
113118 reservedOp "as"
@@ -130,6 +135,7 @@ ungroupP = do
130135relOperators = [
131136 [Postfix projectOp],
132137 [Postfix renameP],
138+ [Postfix whereClauseP],
133139 [Postfix groupP],
134140 [Postfix ungroupP],
135141 [Infix (reservedOp "join" >> return Join) AssocLeft],
@@ -182,14 +188,6 @@ updateP = do
182188 attributeAssignments <- liftM M.fromList $ parens (sepBy attributeAssignment comma)
183189 return $ Update relVarName attributeAssignments
184190
185−{-
186−restrictionPredicateP :: Parser RestrictionPredicateExpr
187−restrictionPredicateP = do
188− sepBy1 subexpr (
189− where
190− subexpr = try attributeEqP <|>
191−-}
192−
193191constraintP :: Parser DatabaseExpr
194192constraintP = do
195193 reservedOp "constraint"
@@ -213,15 +211,15 @@ parseString str = case parse multipleDatabaseExpr "" str of
213211
214212data TutorialDOperator where
215213 ShowRelation :: RelationalExpr -> TutorialDOperator
216− ShowRelationVariableType :: String -> TutorialDOperator
214+ ShowRelationType :: RelationalExpr -> TutorialDOperator
217215 ShowConstraint :: String -> TutorialDOperator
218216 deriving (Show)
219217
220218typeP :: Parser TutorialDOperator
221219typeP = do
222220 reservedOp ":t"
223− relVarName <- identifier
224− return $ ShowRelationVariableType relVarName
221+ expr <- relExpr
222+ return $ ShowRelationType expr
225223
226224showRelP :: Parser TutorialDOperator
227225showRelP = do
@@ -250,9 +248,9 @@ showRelationAttributes rel = "{" ++ concat (L.intersperse ", " $ map showAttribu
250248 values m = map snd (M.toAscList m)
251249
252250evalTutorialDOp :: DatabaseContext -> TutorialDOperator -> String
253−evalTutorialDOp context (ShowRelationVariableType relVarName) = case M.lookup relVarName (relationVariables context) of
254− Just rel -> showRelationAttributes rel
255− Nothing -> relVarName ++ " not defined"
251+evalTutorialDOp context (ShowRelationType expr) = case runState (typeForRelationalExpr expr) context of
252+ (Right rel, _) -> showRelationAttributes rel
253+ (Left err, _) -> show err
256254
257255evalTutorialDOp context (ShowRelation expr) = do
258256 case runState (evalRelationalExpr expr) context of
@@ -309,3 +307,35 @@ reprLoop context = do
309307 putStrLn $ show err
310308 reprLoop context
311309
310+restrictionPredicateP :: Parser RestrictionPredicateExpr
311+restrictionPredicateP = buildExpressionParser predicateOperators predicateTerm
312+ where
313+ predicateOperators = [
314+ [Infix (reservedOp "and" >> return AndPredicate) AssocLeft],
315+ [Infix (reservedOp "or" >> return OrPredicate) AssocLeft]
316+ ]
317+ predicateTerm = parens restrictionPredicateP
318+ <|> try restrictionAttributeEqualityP
319+ <|> relationalBooleanExpr
320+
321+relationalBooleanExpr :: Parser RestrictionPredicateExpr
322+relationalBooleanExpr = do
323+ relexpr <- relExpr
324+ return $ RelationalExprPredicate relexpr
325+
326+restrictionAttributeEqualityP :: Parser RestrictionPredicateExpr
327+restrictionAttributeEqualityP = do
328+ attributeName <- identifier
329+ reservedOp "="
330+ atom <- stringAtomP <|> intAtomP
331+ return $ AttributeEqualityPredicate attributeName atom
332+
333+quotedChar = noneOf "\""
334+ <|> try (string "\"\"" >> return '"')
335+
336+stringAtomP = liftA StringAtom (string "\"" *> many quotedChar <* string "\"")
337+
338+intAtomP = do
339+ intstr <- many digit
340+ return $ IntAtom (read intstr)
341+