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