@@ -31,7 +31,7 @@ main = do
31 tcounts <- runTestTT (TestList tests)
31 tcounts <- runTestTT (TestList tests)
32 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
32 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
34− 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]
34+ 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]
35 simpleRelTests = [("x:=true", Right relationTrue),
35 simpleRelTests = [("x:=true", Right relationTrue),
36 ("x:=false", Right relationFalse),
36 ("x:=false", Right relationFalse),
37 ("x:=true union false", Right relationTrue),
37 ("x:=true union false", Right relationTrue),
@@ -266,4 +266,24 @@ testNotification = TestCase $ do
266 check' $ commit sess conn
266 check' $ commit sess conn
267 check' $ executeDatabaseContextExpr sess conn (Assign "x" (ExistingRelation relationFalse))
267 check' $ executeDatabaseContextExpr sess conn (Assign "x" (ExistingRelation relationFalse))
268 check' $ commit sess conn
268 check' $ commit sess conn
269− takeMVar notifmvar
269+ takeMVar notifmvar
271+executeTutorialD :: SessionId -> Connection -> String -> IO ()
272+executeTutorialD sessionId conn tutd = case parseTutorialD tutd of
273+ Left err -> assertFailure (show tutd ++ ": " ++ show err)
275+ result <- evalTutorialD sessionId conn parsed
277+ QuitResult -> assertFailure "quit?"
278+ DisplayResult _ -> assertFailure "display?"
279+ DisplayIOResult _ -> assertFailure "displayIO?"
280+ DisplayErrorResult err -> assertFailure (show err)
281+ QuietSuccessResult -> pure ()
283+testTypeConstructors :: Test
284+testTypeConstructors = TestCase $ do
285+ (sessionId, dbconn) <- dateExamplesConnection emptyNotificationCallback
286+ executeTutorialD sessionId dbconn "data Hair = Color Text | Bald | UserRefusesToSpecify"
287+ executeTutorialD sessionId dbconn "x:=relation{a Hair}{tuple{a Color \"Blonde\"},tuple{a Bald},tuple{a UserRefusesToSpecify}}"
288+ executeTutorialD sessionId dbconn "data Tree a = Node a (Tree a) (Tree a) | EmptyNode"
289+ executeTutorialD sessionId dbconn "y:=relation{a Tree Int}{tuple{a Node 3 (Node 4 EmptyNode EmptyNode) EmptyNode},tuple{a Node 4 EmptyNode EmptyNode}}"