git.iko.soy/project-m36
on 9aedcf2 help sign in
project-m36/test/TutorialD/Interpreter/TestBase.hs
58 lines 2.9 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 -> assertFailure "quit?"
35 DisplayResult _ -> assertFailure "display?"
36 DisplayIOResult _ -> assertFailure "displayIO?"
37 DisplayRelationResult _ -> assertFailure "displayrelation?"
38 DisplayParseErrorResult _ _ -> assertFailure "displayparseerrorresult?"
39 DisplayErrorResult err -> assertFailure (show err)
40 QuietSuccessResult -> pure ()
42expectTutorialDErr :: SessionId -> Connection -> (Text -> Bool) -> Text -> IO ()
43expectTutorialDErr sessionId conn matchFunc tutd = case parseTutorialD tutd of
44 Left err -> assertFailure (show tutd ++ ": " ++ show err)
45 Right parsed -> do
46 result <- evalTutorialD sessionId conn UnsafeEvaluation parsed
47 case result of
48 QuitResult -> assertFailure "quit?"
49 DisplayResult _ -> assertFailure "display?"
50 DisplayIOResult _ -> assertFailure "displayIO?"
51 DisplayRelationResult _ -> assertFailure "displayrelation?"
52 DisplayParseErrorResult _ _ -> assertFailure "displayparseerrorresult?"
53 DisplayErrorResult err -> assertBool ("match error on: " ++ unpack err) (matchFunc err)
54 QuietSuccessResult -> pure ()
56eitherFail :: Either RelationalError a -> IO ()
57eitherFail (Left err) = assertFailure (show err)
58eitherFail (Right _) = pure ()