git.iko.soy/project-m36
on 52182bc help sign in
project-m36/test/TutorialD/Interpreter/TestBase.hs
60 lines 3.1 kB history raw
1module TutorialD.Interpreter.TestBase where
2import ProjectM36.Client
3import TutorialD.Interpreter
4import TutorialD.Interpreter.Base
5import qualified ProjectM36.Base as Base
6import ProjectM36.DateExamples
7import Test.HUnit
8import qualified Data.Map as M
9import Data.Text
11dateExamplesConnection :: NotificationCallback -> IO (SessionId, Connection)
12dateExamplesConnection callback = do
13 dbconn <- connectProjectM36 (InProcessConnectionInfo NoPersistence callback [])
14 let incDeps = Base.inclusionDependencies dateExamples
15 case dbconn of
16 Left err -> error (show err)
17 Right conn -> do
18 eSessionId <- createSessionAtHead conn "master"
19 case eSessionId of
20 Left err -> error (show err)
21 Right sessionId -> do
22 mapM_ (\(rvName,rvRel) -> executeDatabaseContextExpr sessionId conn (Assign rvName (Base.ExistingRelation rvRel))) (M.toList (Base.relationVariables dateExamples))
23 mapM_ (\(idName,incDep) -> executeDatabaseContextExpr sessionId conn (AddInclusionDependency idName incDep)) (M.toList incDeps)
24 --skipping atom functions for now- there are no atom function manipulation operators yet
25 commit sessionId conn >>= eitherFail
26 pure (sessionId, conn)
28executeTutorialD :: SessionId -> Connection -> Text -> IO ()
29executeTutorialD sessionId conn tutd = case parseTutorialD tutd of
30 Left err -> assertFailure (show tutd ++ ": " ++ show err)
31 Right parsed -> do
32 result <- evalTutorialD sessionId conn UnsafeEvaluation parsed
33 case result of
34 QuitResult -> putStrLn "yyy" >> assertFailure "quit?"
35 DisplayResult _ -> putStrLn "xxx" >> assertFailure "display?"
36 DisplayIOResult _ -> putStrLn "z" >> assertFailure "displayIO?"
37 DisplayRelationResult _ -> putStrLn "Y" >> assertFailure "displayrelation?"
38 DisplayDataFrameResult _ -> putStrLn "DF" >> assertFailure "displaydataframe?"
39 DisplayParseErrorResult _ _ -> putStrLn "X" >> assertFailure "displayparseerrorresult?"
40 DisplayErrorResult err -> putStrLn "asd" >> assertFailure (show tutd ++ ": " ++ show err)
41 QuietSuccessResult -> pure ()
43expectTutorialDErr :: SessionId -> Connection -> (Text -> Bool) -> Text -> IO ()
44expectTutorialDErr sessionId conn matchFunc tutd = case parseTutorialD tutd of
45 Left err -> assertFailure (show tutd ++ ": " ++ show err)
46 Right parsed -> do
47 result <- evalTutorialD sessionId conn UnsafeEvaluation parsed
48 case result of
49 QuitResult -> assertFailure "quit?"
50 DisplayResult _ -> assertFailure "display?"
51 DisplayIOResult _ -> assertFailure "displayIO?"
52 DisplayRelationResult _ -> assertFailure "displayrelation?"
53 DisplayDataFrameResult _ -> assertFailure "displaydataframe?"
54 DisplayParseErrorResult _ _ -> assertFailure "displayparseerrorresult?"
55 DisplayErrorResult err -> assertBool ("match error on: " ++ unpack err) (matchFunc err)
56 QuietSuccessResult -> pure ()
58eitherFail :: Either RelationalError a -> IO ()
59eitherFail (Left err) = assertFailure (show err)
60eitherFail (Right _) = pure ()