@@ -16,23 +16,26 @@ import ProjectM36.Key
1616
1717--parsers which create "database expressions" which modify the database context (such as relvar assignment)
1818databaseExprP :: Parser DatabaseExpr
19−databaseExprP = insertP
20− <|> deleteConstraintP
21− <|> deleteP
22− <|> updateP
23− <|> addConstraintP
24− <|> keyP
25− <|> defineP
26− <|> undefineP
27− <|> assignP
28− <|> addNotificationP
29− <|> removeNotificationP
30− <|> addTypeConstructorP
31− <|> removeTypeConstructorP
32− <|> nothingP
19+databaseExprP = choice $ map (\p -> p <* optional commentP) [insertP,
20+ deleteConstraintP,
21+ deleteP,
22+ updateP,
23+ addConstraintP,
24+ keyP,
25+ defineP,
26+ undefineP,
27+ assignP,
28+ addNotificationP,
29+ removeNotificationP,
30+ addTypeConstructorP,
31+ removeTypeConstructorP,
32+ nothingP]
33+
34+commentP :: Parser DatabaseExpr
35+commentP = reserved "--" >> manyTill anyChar eof >> pure NoOperation
3336
3437nothingP :: Parser DatabaseExpr
35−nothingP = (whiteSpace <* eof) >> pure NoOperation
38+nothingP = whiteSpace >> pure NoOperation
3639
3740assignP :: Parser DatabaseExpr
3841assignP = do
@@ -85,14 +88,23 @@ updateP = do
8588 attributeAssignments <- liftM M.fromList $ parens (sepBy attributeAssignmentP comma)
8689 return $ Update (T.pack relVarName) (M.mapKeys T.pack $ attributeAssignments) predicate
8790
91+data IncDepOp = SubsetOp | EqualityOp
92+
8893addConstraintP :: Parser DatabaseExpr
8994addConstraintP = do
9095 reservedOp "constraint" <|> reservedOp "foreign key"
9196 constraintName <- identifier
9297 subset <- relExprP
93− reservedOp "in"
98+ op <- (reservedOp "in" *> pure SubsetOp) <|> (reservedOp "equals" *> pure EqualityOp)
9499 superset <- relExprP
95− return $ AddInclusionDependency (T.pack constraintName) (InclusionDependency subset superset)
100+ let subsetA = incDepSet constraintName subset superset
101+ subsetB = incDepSet (constraintName ++ "_eqInvert") superset subset --inverted args for equality constraint
102+ incDepSet nam a b = AddInclusionDependency (T.pack nam) (InclusionDependency a b)
103+ case op of
104+ SubsetOp -> pure subsetA
105+ EqualityOp -> pure (MultipleExpr [subsetA, subsetB])
106+
107+
96108
97109deleteConstraintP :: Parser DatabaseExpr
98110deleteConstraintP = do