feat: retry failed tests x times

lib/OSnap.ml

@@ -20,9 +20,9 @@ let setup ~sw ~env ~noCreate ~noOnly ~noSkip ~config_path =
   let*? all_tests = Config.Test.init config in
   let*? only_tests, tests =
     all_tests
-    |> ResultList.map_p_until_first_error (fun test ->
+    |> ResultList.traverse (fun test ->
       test.sizes
-      |> ResultList.map_p_until_first_error (fun size ->
+      |> ResultList.traverse (fun size ->
         let { name = _size_name; width; height } = size in
         let filename = Test.get_filename test.name width height in
         let current_image_path = Eio.Path.(snapshot_dir / filename) in
@@ -70,39 +70,53 @@ let setup ~sw ~env ~noCreate ~noOnly ~noSkip ~config_path =
 let teardown t = Browser.Launcher.shutdown t.browser
 
 let run ~env t =
-  let ( let*? ) = Result.bind in
   let open Config.Types in
   let { tests_to_run; config; start_time; browser } = t in
-  let parallelism = Domain.recommended_domain_count () * 3 in
+  let num_domains = Domain.recommended_domain_count () in
+  let parallelism = num_domains * 3 in
   let pool =
     Eio.Pool.create
       ~validate:(fun target -> Result.is_ok target)
       parallelism
       (fun () -> Browser.Target.make browser)
   in
   Test.Printer.Progress.set_total (List.length tests_to_run);
+  let rec run_remaining lst =
+    let*? result =
+      lst
+      |> ResultList.traverse (function
+        | Test.Types.{ result = None | Some (`Retry _); _ } as test ->
+          Eio.Pool.use pool (fun target ->
+            Test.run ~env config (Result.get_ok target) test)
+        | r -> Ok r)
+    in
+    let has_retries =
+      result
+      |> List.exists (function
+        | Test.Types.{ result = None | Some (`Retry _); _ } -> true
+        | _ -> false)
+    in
+    if has_retries then run_remaining result else Ok result
+  in
   let*? test_results =
     tests_to_run
-    |> ResultList.map_p_until_first_error (fun test ->
-      Eio.Pool.use pool (fun target ->
-        let test, { name = size_name; width; height }, exists = test in
-        let test =
-          Test.Types.
-            { exists
-            ; size_name
-            ; width
-            ; height
-            ; skip = test.OSnap_Config.Types.skip
-            ; url = test.OSnap_Config.Types.url
-            ; name = test.OSnap_Config.Types.name
-            ; actions = test.OSnap_Config.Types.actions
-            ; ignore_regions = test.OSnap_Config.Types.ignore
-            ; threshold = test.OSnap_Config.Types.threshold
-            ; warnings = []
-            ; result = None
-            }
-        in
-        Test.run ~env config (Result.get_ok target) test))
+    |> List.map (fun target ->
+      let test, { name = size_name; width; height }, exists = target in
+      Test.Types.
+        { exists
+        ; size_name
+        ; width
+        ; height
+        ; skip = test.OSnap_Config.Types.skip
+        ; url = test.OSnap_Config.Types.url
+        ; name = test.OSnap_Config.Types.name
+        ; actions = test.OSnap_Config.Types.actions
+        ; ignore_regions = test.OSnap_Config.Types.ignore
+        ; threshold = test.OSnap_Config.Types.threshold
+        ; warnings = []
+        ; result = None
+        })
+    |> run_remaining
   in
   let end_time = Unix.gettimeofday () in
   let seconds = end_time -. start_time in

lib/OSnap_Test/OSnap_Test.ml

@@ -124,7 +124,7 @@ let get_ignore_regions ~document target size_name regions =
     | Error (`OSnap_Selector_Not_Found _s) -> None
     | Error (`OSnap_Selector_Not_Visible _s) -> None
     | Error (`OSnap_CDP_Protocol_Error _ as e) -> Some (Result.error e))
-  |> ResultList.map_p_until_first_error Fun.id
+  |> ResultList.traverse Fun.id
   |> Result.map List.flatten
 ;;
 
@@ -216,15 +216,19 @@ let run ~env (global_config : Config.Types.global) target test =
             let*? () = save_screenshot screenshot ~path:updated_snapshot in
             Result.ok (`Failed `Layout)
           | Error (Pixel (diffCount, diffPercentage)) ->
-            Printer.diff_message
-              ~print_head:true
-              ~name:test.name
-              ~width:test.width
-              ~height:test.height
-              ~diffCount
-              ~diffPercentage;
-            let*? () = save_screenshot screenshot ~path:updated_snapshot in
-            Result.ok (`Failed (`Pixel (diffCount, diffPercentage)))
+            (match test.result with
+             | None -> Result.ok (`Retry 3)
+             | Some (`Retry i) when i > 0 -> Result.ok (`Retry (pred i))
+             | _ ->
+               Printer.diff_message
+                 ~print_head:true
+                 ~name:test.name
+                 ~width:test.width
+                 ~height:test.height
+                 ~diffCount
+                 ~diffPercentage;
+               let*? () = save_screenshot screenshot ~path:updated_snapshot in
+               Result.ok (`Failed (`Pixel (diffCount, diffPercentage))))
     in
     { test with result = Some result } |> Result.ok)
 ;;

lib/OSnap_Test/OSnap_Test_Types.ml

@@ -15,6 +15,7 @@ type t =
       | `Failed of [ `Io | `Layout | `Pixel of int * float ]
       | `Passed
       | `Skipped
+      | `Retry of int
       ]
         option
   }

lib/OSnap_Utils/OSnap_Utils.ml

@@ -87,7 +87,7 @@ module List = struct
 end
 
 module ResultList = struct
-  let map_p_until_first_error (type err) (fn : 'a -> ('b, err) result) list =
+  let traverse (type err) (fn : 'a -> ('b, err) result) list =
     let exception FoundError of err in
     try
       list