git.iko.soy/project-m36
on 2fbb67a help sign in
project-m36/test/TutorialD/Interpreter/TestBase.hs
57 lines 2.7 kB history raw
1module TutorialD.Interpreter.TestBase where
2import ProjectM36.Client
3import TutorialD.Interpreter
4import TutorialD.Interpreter.Base
5import ProjectM36.DateExamples
6import ProjectM36.DatabaseContext
7import Test.HUnit
8import Data.Text
10dateExamplesConnection :: NotificationCallback -> IO (SessionId, Connection)
11dateExamplesConnection callback = do
12 dbconn <- connectProjectM36 (InProcessConnectionInfo NoPersistence callback [])
13 case dbconn of
14 Left err -> error (show err)
15 Right conn -> do
16 eSessionId <- createSessionAtHead conn "master"
17 case eSessionId of
18 Left err -> error (show err)
19 Right sessionId -> do
20 executeDatabaseContextExpr sessionId conn (databaseContextAsDatabaseContextExpr dateExamples) >>= eitherFail
21 --skipping atom functions for now- there are no atom function manipulation operators yet
22 commit sessionId conn >>= eitherFail
23 pure (sessionId, conn)
25executeTutorialD :: SessionId -> Connection -> Text -> IO ()
26executeTutorialD sessionId conn tutd = case parseTutorialD tutd of
27 Left err -> assertFailure (show tutd ++ ": " ++ show err)
28 Right parsed -> do
29 result <- evalTutorialD sessionId conn UnsafeEvaluation parsed
30 case result of
31 QuitResult -> assertFailure "quit?"
32 DisplayResult _ -> assertFailure "display?"
33 DisplayIOResult _ -> assertFailure "displayIO?"
34 DisplayRelationResult _ -> assertFailure "displayrelation?"
35 DisplayDataFrameResult _ -> assertFailure "displaydataframe?"
36 DisplayParseErrorResult _ _ -> assertFailure "displayparseerrorresult?"
37 DisplayErrorResult err -> assertFailure (show tutd ++ ": " ++ show err)
38 QuietSuccessResult -> pure ()
40expectTutorialDErr :: SessionId -> Connection -> (Text -> Bool) -> Text -> IO ()
41expectTutorialDErr sessionId conn matchFunc tutd = case parseTutorialD tutd of
42 Left err -> assertFailure (show tutd ++ ": " ++ show err)
43 Right parsed -> do
44 result <- evalTutorialD sessionId conn UnsafeEvaluation parsed
45 case result of
46 QuitResult -> assertFailure "quit?"
47 DisplayResult _ -> assertFailure "display?"
48 DisplayIOResult _ -> assertFailure "displayIO?"
49 DisplayRelationResult _ -> assertFailure "displayrelation?"
50 DisplayDataFrameResult _ -> assertFailure "displaydataframe?"
51 DisplayParseErrorResult _ _ -> assertFailure "displayparseerrorresult?"
52 DisplayErrorResult err -> assertBool ("match error on: " ++ unpack err) (matchFunc err)
53 QuietSuccessResult -> pure ()
55eitherFail :: Either RelationalError a -> IO ()
56eitherFail (Left err) = assertFailure (show err)
57eitherFail (Right _) = pure ()