git.iko.soy/project-m36
on master help sign in
allow multiple attribute renames as part of tutd rename clause

fixes #47

commit8cfc3ee2f9096e40f618231c80d9f31d0ede7387 authorAgentM <agentm@themactionfaction.com> dateWed 21 Sep 2016, 11:31 (10 years ago) parent79f2d42
2 files changed+17−5
compare with master
unifiedsplit
src/bin/TutorialD/Interpreter/RelationalExpr.hs+5−2 test/TutorialD/Interpreter.hs+12−3
src/bin/TutorialD/Interpreter/RelationalExpr.hs+5−2
@@ -80,8 +80,11 @@ renameClauseP = do
8080renameP :: RelationalMarkerExpr a => Parser (RelationalExprBase a -> RelationalExprBase a)
8181renameP = do
8282 reservedOp "rename"
83− (oldAttr, newAttr) <- braces renameClauseP
84− return $ Rename oldAttr newAttr
83+ renameList <- braces (sepBy renameClauseP comma)
84+ case renameList of
85+ [] -> pure (Restrict TruePredicate) --no-op when rename list is empty
86+ renames -> do
87+ pure $ \expr -> foldl (\acc (oldAttr, newAttr) -> Rename oldAttr newAttr acc) expr renames
8588
8689whereClauseP :: RelationalMarkerExpr a => Parser (RelationalExprBase a -> RelationalExprBase a)
8790whereClauseP = reservedOp "where" *> (Restrict <$> restrictionPredicateP)
test/TutorialD/Interpreter.hs+12−3
@@ -32,7 +32,7 @@ main = do
3232 tcounts <- runTestTT (TestList tests)
3333 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
3434 where
35− tests = map (\(tutd, expected) -> TestCase $ assertTutdEqual basicDatabaseContext expected tutd) simpleRelTests ++ map (\(tutd, expected) -> TestCase $ assertTutdEqual dateExamples expected tutd) dateExampleRelTests ++ [transactionGraphBasicTest, transactionGraphAddCommitTest, transactionRollbackTest, transactionJumpTest, transactionBranchTest, simpleJoinTest, testNotification, testTypeConstructors, testMergeTransactions, testComments, testTransGraphRelationalExpr]
35+ tests = map (\(tutd, expected) -> TestCase $ assertTutdEqual basicDatabaseContext expected tutd) simpleRelTests ++ map (\(tutd, expected) -> TestCase $ assertTutdEqual dateExamples expected tutd) dateExampleRelTests ++ [transactionGraphBasicTest, transactionGraphAddCommitTest, transactionRollbackTest, transactionJumpTest, transactionBranchTest, simpleJoinTest, testNotification, testTypeConstructors, testMergeTransactions, testComments, testTransGraphRelationalExpr, failJoinTest, testMultiAttributeRename]
3636 simpleRelTests = [("x:=true", Right relationTrue),
3737 ("x:=false", Right relationFalse),
3838 ("x:=true union false", Right relationTrue),
@@ -208,7 +208,7 @@ transactionBranchTest = TestCase $ do
208208
209209-- test that overlapping attribute names with different types fail with an error
210210failJoinTest :: Test
211−failJoinTest = TestCase $ assertTutdEqual basicDatabaseContext err "x:=relation{tuple{test Int}} join relation{tuple{test Text}}"
211+failJoinTest = TestCase $ assertTutdEqual basicDatabaseContext err "x:=relation{tuple{test 4}} join relation{tuple{test \"test\"}}"
212212 where
213213 err = Left (TupleAttributeTypeMismatchError (A.attributesFromList [Attribute "test" IntAtomType]))
214214
@@ -331,4 +331,13 @@ testTransGraphRelationalExpr = TestCase $ do
331331 let testBranchBacktrack = TransactionIdHeadNameLookup "testbranch" [TransactionIdHeadParentBacktrack 1]
332332 backtrackRel <- executeTransGraphRelationalExpr sessionId dbconn (Equals (RelationVariable "s" testBranchBacktrack) (RelationVariable "s" masterMarker))
333333 assertEqual "backtrack to master" (Right relationTrue) backtrackRel
334−
334+
335+
336+testMultiAttributeRename :: Test
337+testMultiAttributeRename = TestCase $ assertTutdEqual dateExamples renamedRel "x:=s rename {city as town, status as price} where false"
338+ where
339+ sattrs = attributesFromList [Attribute "town" TextAtomType,
340+ Attribute "sname" TextAtomType,
341+ Attribute "s#" TextAtomType,
342+ Attribute "price" IntAtomType]
343+ renamedRel = mkRelationFromList sattrs []