@@ -31,7 +31,7 @@ main = do
3131 tcounts <- runTestTT (TestList tests)
3232 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
3333 where
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]
3535 simpleRelTests = [("x:=true", Right relationTrue),
3636 ("x:=false", Right relationFalse),
3737 ("x:=true union false", Right relationTrue),
@@ -266,4 +266,24 @@ testNotification = TestCase $ do
266266 check' $ commit sess conn
267267 check' $ executeDatabaseContextExpr sess conn (Assign "x" (ExistingRelation relationFalse))
268268 check' $ commit sess conn
269− takeMVar notifmvar
269+ takeMVar notifmvar
270+
271+executeTutorialD :: SessionId -> Connection -> String -> IO ()
272+executeTutorialD sessionId conn tutd = case parseTutorialD tutd of
273+ Left err -> assertFailure (show tutd ++ ": " ++ show err)
274+ Right parsed -> do
275+ result <- evalTutorialD sessionId conn parsed
276+ case result of
277+ QuitResult -> assertFailure "quit?"
278+ DisplayResult _ -> assertFailure "display?"
279+ DisplayIOResult _ -> assertFailure "displayIO?"
280+ DisplayErrorResult err -> assertFailure (show err)
281+ QuietSuccessResult -> pure ()
282+
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}}"