@@ -77,22 +77,28 @@ testFunctionPersistence :: Test
7777testFunctionPersistence = TestCase $ withSystemTempDirectory "m36testdb" $ \tempdir -> do
7878 let dbdir = tempdir </> "dbdir"
7979 connInfo = InProcessConnectionInfo (MinimalPersistence dbdir) emptyNotificationCallback []
80− Right conn <- connectProjectM36 connInfo
81− Right sess <- createSessionAtHead conn "master"
80+ conn <- assertIOEither $ connectProjectM36 connInfo
81+ sess <- assertIOEither $ createSessionAtHead conn "master"
8282 let intTCons = PrimitiveTypeConstructor "Int" IntAtomType
8383 addfunc = AddAtomFunction "testdisk" [
8484 intTCons,
8585 ADTypeConstructor "Either" [ADTypeConstructor "AtomFunctionError" [],
8686 intTCons]] "(\\(x:_) -> pure x) :: [Atom] -> Either AtomFunctionError Atom"
87− Right () <- executeDatabaseContextIOExpr sess conn addfunc
88− Right () <- commit sess conn
87+ _ <- assertIOEither $ executeDatabaseContextIOExpr sess conn addfunc
88+
89+ _ <- assertIOEither $ commit sess conn
8990 close conn
9091 --re-open the connection to reload the graph
91− Right conn2 <- connectProjectM36 connInfo
92− Right sess2 <- createSessionAtHead conn2 "master"
92+ conn2 <- assertIOEither $ connectProjectM36 connInfo
93+ sess2 <- assertIOEither $ createSessionAtHead conn2 "master"
9394
9495 res <- executeRelationalExpr sess2 conn2 (MakeRelationFromExprs Nothing [TupleExpr (M.singleton "a" (FunctionAtomExpr "testdisk" [NakedAtomExpr (IntAtom 3)] ()))])
9596 let expectedRel = mkRelationFromList (attributesFromList [Attribute "a" IntAtomType]) [[IntAtom 3]]
9697 assertEqual "testdisk dbc function run" expectedRel res
9798
98−
99+assertIOEither :: (Show a) => IO (Either a b) -> IO b
100+assertIOEither x = do
101+ ret <- x
102+ case ret of
103+ Left err -> assertFailure (show err) >> undefined
104+ Right val -> pure val