git.iko.soy/project-m36
on master help sign in
add syntax for union and intersection of attributes
commit028a0e4f6e7aa05f317177dfbd183477c3bed806 authorAgentM <agentm@themactionfaction.com> dateSun 22 Nov 2020, 14:15 (6 years ago) parentab0a95c
3 files changed+26−6
compare with master
unifiedsplit
src/bin/TutorialD/Interpreter/RelationalExpr.hs+10−1 src/bin/TutorialD/Printer.hs+2−4 test/TutorialD/Interpreter.hs+14−1
src/bin/TutorialD/Interpreter/RelationalExpr.hs+10−1
@@ -20,9 +20,18 @@ attributeListP :: RelationalMarkerExpr a => Parser (AttributeNamesBase a)
2020attributeListP =
2121 (reservedOp "all but" >>
2222 InvertedAttributeNames . S.fromList <$> sepBy attributeNameP comma) <|>
23+
2324 (reservedOp "all from" >>
2425 RelationalExprAttributeNames <$> relExprP) <|>
25− (AttributeNames . S.fromList <$> sepBy attributeNameP comma)
26+
27+ (reservedOp "union of" >>
28+ UnionAttributeNames <$> braces attributeListP <*> braces attributeListP) <|>
29+
30+ (reservedOp "intersection of" >>
31+ IntersectAttributeNames <$> braces attributeListP <*> braces attributeListP) <|>
32+
33+ (AttributeNames . S.fromList <$> sepBy attributeNameP comma)
34+
2635
2736makeRelationP :: RelationalMarkerExpr a => Parser (RelationalExprBase a)
2837makeRelationP = do
src/bin/TutorialD/Printer.hs+2−4
@@ -107,10 +107,8 @@ instance Pretty AttributeNames where
107107 pretty (AttributeNames attrNames) = prettyBracesList (S.toList attrNames)
108108 pretty (InvertedAttributeNames attrNames) = braces $ "all but" <+> concatWith (surround ", ") (map pretty (S.toList attrNames))
109109 pretty (RelationalExprAttributeNames relExpr) = braces $ "all from" <+> pretty relExpr
110− pretty a = error $ show a ++ " is not implemented yet."
111−-- YuMing L.: I guess these two are used in evaluating relational expressions. So we won't be using them in pretty printer.
112−-- pretty (UnionAttributeNames aAttrNames bAttrNames) = prettyBracesList (S.toList (aAttrNames `union` bAttrNames))
113−-- pretty (IntersectAttributeNames aAttrNames bAttrNames) = prettyBracesList (S.toList (aAttrNames `intersection` bAttrNames))
110+ pretty (UnionAttributeNames aAttrNames bAttrNames) = braces ("union of" <+> pretty aAttrNames <+> pretty bAttrNames)
111+ pretty (IntersectAttributeNames aAttrNames bAttrNames) = braces ("intersection of" <+> pretty aAttrNames <+> pretty bAttrNames)
114112
115113instance Pretty AttributeExpr where
116114 pretty (NakedAttributeExpr attr) = pretty attr
test/TutorialD/Interpreter.hs+14−1
@@ -80,7 +80,8 @@ main = do
8080 testBasicList,
8181 testRelationDeclarationMismatch,
8282 testInvalidTuples,
83− testSelfReferencingUncommittedContext
83+ testSelfReferencingUncommittedContext,
84+ testUnionAndIntersectionAttributeExprs
8485 ]
8586
8687simpleRelTests :: Test
@@ -711,3 +712,15 @@ testSelfReferencingUncommittedContext = TestCase $ do
711712 _ <- rollback sessionId dbconn
712713 eSorig <- executeRelationalExpr sessionId dbconn (RelationVariable "s" ())
713714 assertEqual "s=s'" eSorig eS
715+
716+testUnionAndIntersectionAttributeExprs :: Test
717+testUnionAndIntersectionAttributeExprs = TestCase $ do
718+ (sessionId, dbconn) <- dateExamplesConnection emptyNotificationCallback
719+ executeTutorialD sessionId dbconn "x:=s{intersection of {all but sname} {sname}}"
720+ xRel <- executeRelationalExpr sessionId dbconn (RelationVariable "x" ())
721+ assertEqual "intersection attrs" (Right relationTrue) xRel
722+
723+ executeTutorialD sessionId dbconn "y:=s{union of {all but sname} {sname}}"
724+ yRel <- executeRelationalExpr sessionId dbconn (RelationVariable "y" ())
725+ assertEqual "union attrs" (Right suppliersRel) yRel
726+