Don't mask error in test setup

This commit is contained in:
Reynir Björnsson 2023-09-14 12:52:53 +02:00 committed by Robur
parent 5ec5cb66df
commit 1452de6280

View file

@ -145,7 +145,6 @@ let fail_if_none a =
Option.to_result ~none:(`Msg "Failed to retrieve") a Option.to_result ~none:(`Msg "Failed to retrieve") a
let add_test_build user_id (module Db : CONN) = let add_test_build user_id (module Db : CONN) =
let r =
let open Builder_db in let open Builder_db in
Db.start () >>= fun () -> Db.start () >>= fun () ->
Db.exec Job.try_add job_name >>= fun () -> Db.exec Job.try_add job_name >>= fun () ->
@ -157,17 +156,6 @@ let add_test_build user_id (module Db : CONN) =
Db.find last_insert_rowid () >>= fun main_binary_id -> Db.find last_insert_rowid () >>= fun main_binary_id ->
Db.exec Build.set_main_binary (id, main_binary_id) >>= fun () -> Db.exec Build.set_main_binary (id, main_binary_id) >>= fun () ->
Db.commit () Db.commit ()
in
Result.fold r
~ok:Result.ok
~error:(fun e ->
let () =
match e with
| `Msg e -> Printf.eprintf "%s\n%!" e
| #Caqti_error.t as e ->
Fmt.epr "%a" Caqti_error.pp e
in
Db.rollback ())
let with_build_db f () = let with_build_db f () =
or_fail or_fail