git.iko.soy/project-m36
on e0e000c help sign in
project-m36/test/TutorialD/Interpreter/TestBase.hs
43 lines 2.0 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 "master" conn
19 case eSessionId of
20 Left err -> error (show err)
21 Right sessionId -> do
22 mapM_ (\(rvName,rvRel) -> executeDatabaseContextExpr sessionId conn (Assign rvName (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 >>= maybeFail
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 DisplayErrorResult err -> assertFailure (show err)
39 QuietSuccessResult -> pure ()
41maybeFail :: (Show a) => Maybe a -> IO ()
42maybeFail (Just err) = assertFailure (show err)
43maybeFail Nothing = return ()