From 40b1ed9495704b506b276789afbe9927fed85574 Mon Sep 17 00:00:00 2001 From: Torben Ewert Date: Fri, 19 Apr 2024 20:38:05 +0200 Subject: [PATCH] chore: format code --- bin/Main.ml | 10 +- lib/OSnap.ml | 100 ++++---- lib/OSnap.mli | 58 ++--- lib/OSnap_Browser/OSnap_Browser_Actions.ml | 234 +++++++++---------- lib/OSnap_Browser/OSnap_Browser_Actions.mli | 66 +++--- lib/OSnap_Browser/OSnap_Browser_Download.ml | 11 +- lib/OSnap_Browser/OSnap_Browser_Launcher.ml | 14 +- lib/OSnap_Browser/OSnap_Browser_Launcher.mli | 10 +- lib/OSnap_Browser/OSnap_Browser_Target.ml | 70 +++--- lib/OSnap_Browser/Zip.ml | 28 +-- lib/OSnap_Cleanup.ml | 24 +- lib/OSnap_Config/OSnap_Config_Global.ml | 80 +++---- lib/OSnap_Config/OSnap_Config_Global.mli | 16 +- lib/OSnap_Config/OSnap_Config_Test.ml | 22 +- lib/OSnap_Config/OSnap_Config_Test.mli | 18 +- lib/OSnap_Config/OSnap_Config_Utils.ml | 58 ++--- lib/OSnap_Diff/config/discover.ml | 13 +- lib/OSnap_Diff/png_write/WritePng.ml | 2 +- lib/OSnap_Test/OSnap_Test.ml | 47 ++-- lib/OSnap_Test/OSnap_Test.mli | 4 +- lib/OSnap_Test/OSnap_Test_Printer.ml | 24 +- lib/OSnap_Test/OSnap_Test_Types.ml | 4 +- lib/OSnap_Utils/OSnap_Utils.ml | 16 +- lib/OSnap_Websocket/OSnap_Websocket.ml | 6 +- 24 files changed, 465 insertions(+), 470 deletions(-) diff --git a/bin/Main.ml b/bin/Main.ml index 8e42a0d..4f9db41 100644 --- a/bin/Main.ml +++ b/bin/Main.ml @@ -118,12 +118,12 @@ let default_cmd = (fun () -> OSnap.run t |> Lwt_result.map_error (fun e -> - let () = OSnap.teardown t in - e)) + let () = OSnap.teardown t in + e)) (function - | exn -> - let () = OSnap.teardown t in - Lwt_result.fail (`OSnap_Unknown_Error exn)) + | exn -> + let () = OSnap.teardown t in + Lwt_result.fail (`OSnap_Unknown_Error exn)) in Lwt_main.run run |> handle_response in diff --git a/lib/OSnap.ml b/lib/OSnap.ml index 4c9db03..47a3689 100644 --- a/lib/OSnap.ml +++ b/lib/OSnap.ml @@ -25,37 +25,35 @@ let setup ~noCreate ~noOnly ~noSkip ~parallelism ~config_path = let*? only_tests, tests = all_tests |> Lwt_list.map_p_until_exception (fun test -> - test.sizes - |> Lwt_list.map_p_until_exception (fun size -> - let { name = _size_name; width; height } = size in - let filename = Test.get_filename test.name width height in - let current_image_path = snapshot_dir ^ filename in - let exists = Sys.file_exists current_image_path in - if noCreate && not exists - then - Lwt_result.fail - (`OSnap_Invalid_Run - (Printf.sprintf - "Flag --no-create is set. Cannot create new images for %s." - test.name)) - else if noSkip && test.skip - then - Lwt_result.fail - (`OSnap_Invalid_Run - (Printf.sprintf - "Flag --no-skip is set. Cannot skip test %s." - test.name)) - else if noOnly && test.only - then - Lwt_result.fail - (`OSnap_Invalid_Run - (Printf.sprintf - "Flag --no-only is set but the following test still has only set \ - to true %s." - test.name)) - else if test.only - then Lwt_result.return (Either.left (test, size, exists)) - else Lwt_result.return (Either.right (test, size, exists)))) + test.sizes + |> Lwt_list.map_p_until_exception (fun size -> + let { name = _size_name; width; height } = size in + let filename = Test.get_filename test.name width height in + let current_image_path = snapshot_dir ^ filename in + let exists = Sys.file_exists current_image_path in + if noCreate && not exists + then + Lwt_result.fail + (`OSnap_Invalid_Run + (Printf.sprintf + "Flag --no-create is set. Cannot create new images for %s." + test.name)) + else if noSkip && test.skip + then + Lwt_result.fail + (`OSnap_Invalid_Run + (Printf.sprintf "Flag --no-skip is set. Cannot skip test %s." test.name)) + else if noOnly && test.only + then + Lwt_result.fail + (`OSnap_Invalid_Run + (Printf.sprintf + "Flag --no-only is set but the following test still has only set to \ + true %s." + test.name)) + else if test.only + then Lwt_result.return (Either.left (test, size, exists)) + else Lwt_result.return (Either.right (test, size, exists)))) |> Lwt_result.map List.flatten |> Lwt_result.map (List.partition_map Fun.id) in @@ -67,7 +65,7 @@ let setup ~noCreate ~noOnly ~noSkip ~parallelism ~config_path = let tests_to_run = tests_to_run |> List.fast_sort (fun (_test, _size, exists1) (_test, _size, exists2) -> - Bool.compare exists1 exists2) + Bool.compare exists1 exists2) in let*? browser = Browser.Launcher.make () in Lwt_result.return { config; tests_to_run; start_time; browser } @@ -88,25 +86,25 @@ let run t = let*? test_results = tests_to_run |> Lwt_list.map_p_until_exception (fun test -> - Lwt_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 config (Result.get_ok target) test)) + Lwt_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 config (Result.get_ok target) test)) in let end_time = Unix.gettimeofday () in let seconds = end_time -. start_time in diff --git a/lib/OSnap.mli b/lib/OSnap.mli index c71e035..a6b94d2 100644 --- a/lib/OSnap.mli +++ b/lib/OSnap.mli @@ -15,42 +15,42 @@ val setup -> parallelism:int option -> config_path:string -> ( t - , [> `OSnap_Chromium_Download_Failed - | `OSnap_CDP_Connection_Failed - | `OSnap_CDP_Protocol_Error of string - | `OSnap_Config_Duplicate_Size_Names of string list - | `OSnap_Config_Duplicate_Tests of string list - | `OSnap_Config_Global_Invalid of string - | `OSnap_Config_Global_Not_Found - | `OSnap_Config_Undefined_Function of string * string - | `OSnap_Config_Invalid of string * string - | `OSnap_Config_Parse_Error of string * string - | `OSnap_Config_Unsupported_Format of string - | `OSnap_Invalid_Run of string - ] ) - Lwt_result.t + , [> `OSnap_Chromium_Download_Failed + | `OSnap_CDP_Connection_Failed + | `OSnap_CDP_Protocol_Error of string + | `OSnap_Config_Duplicate_Size_Names of string list + | `OSnap_Config_Duplicate_Tests of string list + | `OSnap_Config_Global_Invalid of string + | `OSnap_Config_Global_Not_Found + | `OSnap_Config_Undefined_Function of string * string + | `OSnap_Config_Invalid of string * string + | `OSnap_Config_Parse_Error of string * string + | `OSnap_Config_Unsupported_Format of string + | `OSnap_Invalid_Run of string + ] ) + Lwt_result.t val teardown : t -> unit val run : t -> ( unit - , [> `OSnap_CDP_Protocol_Error of string - | `OSnap_FS_Error of string - | `OSnap_Test_Failure - ] ) - Lwt_result.t + , [> `OSnap_CDP_Protocol_Error of string + | `OSnap_FS_Error of string + | `OSnap_Test_Failure + ] ) + Lwt_result.t val cleanup : config_path:string -> ( unit - , [> `OSnap_Config_Duplicate_Size_Names of string list - | `OSnap_Config_Duplicate_Tests of string list - | `OSnap_Config_Global_Invalid of string - | `OSnap_Config_Global_Not_Found - | `OSnap_Config_Invalid of string * string - | `OSnap_Config_Parse_Error of string * string - | `OSnap_Config_Undefined_Function of string * string - | `OSnap_Config_Unsupported_Format of string - ] ) - Lwt_result.t + , [> `OSnap_Config_Duplicate_Size_Names of string list + | `OSnap_Config_Duplicate_Tests of string list + | `OSnap_Config_Global_Invalid of string + | `OSnap_Config_Global_Not_Found + | `OSnap_Config_Invalid of string * string + | `OSnap_Config_Parse_Error of string * string + | `OSnap_Config_Undefined_Function of string * string + | `OSnap_Config_Unsupported_Format of string + ] ) + Lwt_result.t diff --git a/lib/OSnap_Browser/OSnap_Browser_Actions.ml b/lib/OSnap_Browser/OSnap_Browser_Actions.ml index f18ecc4..0a27bbb 100644 --- a/lib/OSnap_Browser/OSnap_Browser_Actions.ml +++ b/lib/OSnap_Browser/OSnap_Browser_Actions.ml @@ -24,13 +24,13 @@ let get_document target = |> OSnap_Websocket.send |> Lwt.map Response.parse |> Lwt.map (fun response -> - let error = - response.Response.error - |> Option.map (fun (error : Response.error) -> - `OSnap_CDP_Protocol_Error error.message) - |> Option.value ~default:(`OSnap_CDP_Protocol_Error "") - in - Option.to_result response.Response.result ~none:error) + let error = + response.Response.error + |> Option.map (fun (error : Response.error) -> + `OSnap_CDP_Protocol_Error error.message) + |> Option.value ~default:(`OSnap_CDP_Protocol_Error "") + in + Option.to_result response.Response.result ~none:error) ;; let select_element_all ~document ~selector ~sessionId = @@ -45,14 +45,14 @@ let select_element_all ~document ~selector ~sessionId = |> OSnap_Websocket.send |> Lwt.map Response.parse |> Lwt.map (fun response -> - match response.Response.error, response.Response.result with - | _, Some { nodeIds = [] } -> - Result.error - (`OSnap_CDP_Protocol_Error - (Printf.sprintf "No node with the selector %S could not be found." selector)) - | None, None -> Result.error (`OSnap_CDP_Protocol_Error "") - | Some { message; _ }, None -> Result.error (`OSnap_CDP_Protocol_Error message) - | Some _, Some result | None, Some result -> Result.ok result) + match response.Response.error, response.Response.result with + | _, Some { nodeIds = [] } -> + Result.error + (`OSnap_CDP_Protocol_Error + (Printf.sprintf "No node with the selector %S could not be found." selector)) + | None, None -> Result.error (`OSnap_CDP_Protocol_Error "") + | Some { message; _ }, None -> Result.error (`OSnap_CDP_Protocol_Error message) + | Some _, Some result | None, Some result -> Result.ok result) ;; let select_element ~document ~selector ~sessionId = @@ -67,12 +67,12 @@ let select_element ~document ~selector ~sessionId = |> OSnap_Websocket.send |> Lwt.map Response.parse |> Lwt.map (fun response -> - match response.Response.error, response.Response.result with - | _, (Some { nodeId = `Int 0 } | Some { nodeId = `Float 0. }) -> - Result.error (`OSnap_Selector_Not_Found selector) - | None, None -> Result.error (`OSnap_CDP_Protocol_Error "") - | Some { message; _ }, None -> Result.error (`OSnap_CDP_Protocol_Error message) - | Some _, Some result | None, Some result -> Result.ok result) + match response.Response.error, response.Response.result with + | _, (Some { nodeId = `Int 0 } | Some { nodeId = `Float 0. }) -> + Result.error (`OSnap_Selector_Not_Found selector) + | None, None -> Result.error (`OSnap_CDP_Protocol_Error "") + | Some { message; _ }, None -> Result.error (`OSnap_CDP_Protocol_Error message) + | Some _, Some result | None, Some result -> Result.ok result) ;; let wait_for_network_idle target ~loaderId = @@ -98,13 +98,13 @@ let go_to ~url target = |> OSnap_Websocket.send |> Lwt.map Navigate.Response.parse |> Lwt.map (fun response -> - let error = - response.Response.error - |> Option.map (fun (error : Response.error) -> - `OSnap_CDP_Protocol_Error error.message) - |> Option.value ~default:(`OSnap_CDP_Protocol_Error "") - in - Option.to_result response.Response.result ~none:error) + let error = + response.Response.error + |> Option.map (fun (error : Response.error) -> + `OSnap_CDP_Protocol_Error error.message) + |> Option.value ~default:(`OSnap_CDP_Protocol_Error "") + in + Option.to_result response.Response.result ~none:error) in match result.errorText, result.loaderId with | Some error, _ -> `OSnap_CDP_Protocol_Error error |> Lwt_result.fail @@ -123,56 +123,56 @@ let type_text ~document ~selector ~text target = |> OSnap_Websocket.send |> Lwt.map Response.parse |> Lwt.map (fun response -> - let error = - response.Response.error - |> Option.map (fun (error : Response.error) -> - `OSnap_CDP_Protocol_Error error.message) - |> Option.value ~default:(`OSnap_CDP_Protocol_Error "") - in - Option.to_result response.Response.result ~none:error) + let error = + response.Response.error + |> Option.map (fun (error : Response.error) -> + `OSnap_CDP_Protocol_Error error.message) + |> Option.value ~default:(`OSnap_CDP_Protocol_Error "") + in + Option.to_result response.Response.result ~none:error) |> Lwt_result.map ignore in let*? () = List.init (String.length text) (String.get text) |> Lwt_list.iter_s (fun char -> - let definition = - (OSnap_Browser_KeyDefinition.make char : OSnap_Browser_KeyDefinition.t option) - in - match definition with - | Some def -> - let open Commands.Input.DispatchKeyEvent in - let* () = - Request.make - ~sessionId - ~params: - (Params.make - ~type_:`keyDown - ~windowsVirtualKeyCode: - (def.keyCode - |> Option.map (fun i -> `Int i) - |> Option.value ~default:(`Int 0)) - ~key:def.key - ~code:def.code - ~text:def.text - ~unmodifiedText:def.text - ~location:(`Int def.location) - ~isKeypad:(def.location = 3) - ()) - |> OSnap_Websocket.send - |> Lwt.map ignore - in - Request.make - ~sessionId - ~params: - (Params.make - ~type_:`keyUp - ~key:def.key - ~code:def.code - ~location:(`Int def.location) - ()) - |> OSnap_Websocket.send - |> Lwt.map ignore - | None -> Lwt.return ()) + let definition = + (OSnap_Browser_KeyDefinition.make char : OSnap_Browser_KeyDefinition.t option) + in + match definition with + | Some def -> + let open Commands.Input.DispatchKeyEvent in + let* () = + Request.make + ~sessionId + ~params: + (Params.make + ~type_:`keyDown + ~windowsVirtualKeyCode: + (def.keyCode + |> Option.map (fun i -> `Int i) + |> Option.value ~default:(`Int 0)) + ~key:def.key + ~code:def.code + ~text:def.text + ~unmodifiedText:def.text + ~location:(`Int def.location) + ~isKeypad:(def.location = 3) + ()) + |> OSnap_Websocket.send + |> Lwt.map ignore + in + Request.make + ~sessionId + ~params: + (Params.make + ~type_:`keyUp + ~key:def.key + ~code:def.code + ~location:(`Int def.location) + ()) + |> OSnap_Websocket.send + |> Lwt.map ignore + | None -> Lwt.return ()) |> Lwt_result.ok in let*? wait_result = @@ -203,12 +203,12 @@ let get_quads_all ~document ~selector target = |> OSnap_Websocket.send |> Lwt.map Response.parse |> Lwt.map (fun response -> - match response.Response.error, response.Response.result with - | ( (None | Some _) - , Some - { quads = (x1 :: y1 :: x2 :: _y2 :: _x3 :: y2 :: _x4 :: _y4 :: _) :: _ - } ) -> ((to_float x1, to_float y1), (to_float x2, to_float y2)) :: acc - | _ -> acc)) + match response.Response.error, response.Response.result with + | ( (None | Some _) + , Some + { quads = (x1 :: y1 :: x2 :: _y2 :: _x3 :: y2 :: _x4 :: _y4 :: _) :: _ } + ) -> ((to_float x1, to_float y1), (to_float x2, to_float y2)) :: acc + | _ -> acc)) [] |> Lwt_result.ok ;; @@ -223,13 +223,13 @@ let get_quads ~document ~selector target = |> OSnap_Websocket.send |> Lwt.map Response.parse |> Lwt.map (fun response -> - let error = - response.Response.error - |> Option.map (fun (error : Response.error) -> - `OSnap_CDP_Protocol_Error error.message) - |> Option.value ~default:(`OSnap_CDP_Protocol_Error "") - in - Option.to_result response.Response.result ~none:error) + let error = + response.Response.error + |> Option.map (fun (error : Response.error) -> + `OSnap_CDP_Protocol_Error error.message) + |> Option.value ~default:(`OSnap_CDP_Protocol_Error "") + in + Option.to_result response.Response.result ~none:error) in let to_float = function | `Float f -> f @@ -325,9 +325,9 @@ let scroll ~document ~selector ~px target = |> OSnap_Websocket.send |> Lwt.map Response.parse |> Lwt.map (fun response -> - match response.Response.error with - | None -> Result.ok () - | Some { message; _ } -> Result.error (`OSnap_CDP_Protocol_Error message)) + match response.Response.error with + | None -> Result.ok () + | Some { message; _ } -> Result.error (`OSnap_CDP_Protocol_Error message)) | Some px, None -> let expression = Printf.sprintf @@ -362,13 +362,13 @@ let get_content_size target = |> OSnap_Websocket.send |> Lwt.map Response.parse |> Lwt.map (fun response -> - let error = - response.Response.error - |> Option.map (fun (error : Response.error) -> - `OSnap_CDP_Protocol_Error error.message) - |> Option.value ~default:(`OSnap_CDP_Protocol_Error "") - in - Option.to_result response.Response.result ~none:error) + let error = + response.Response.error + |> Option.map (fun (error : Response.error) -> + `OSnap_CDP_Protocol_Error error.message) + |> Option.value ~default:(`OSnap_CDP_Protocol_Error "") + in + Option.to_result response.Response.result ~none:error) in Lwt_result.return (metrics.cssContentSize.width, metrics.cssContentSize.height) ;; @@ -384,13 +384,13 @@ let set_size ~width ~height target = |> OSnap_Websocket.send |> Lwt.map Response.parse |> Lwt.map (fun response -> - let error = - response.Response.error - |> Option.map (fun (error : Response.error) -> - `OSnap_CDP_Protocol_Error error.message) - |> Option.value ~default:(`OSnap_CDP_Protocol_Error "") - in - Option.to_result response.Response.result ~none:error) + let error = + response.Response.error + |> Option.map (fun (error : Response.error) -> + `OSnap_CDP_Protocol_Error error.message) + |> Option.value ~default:(`OSnap_CDP_Protocol_Error "") + in + Option.to_result response.Response.result ~none:error) in Lwt_result.return () ;; @@ -413,13 +413,13 @@ let screenshot ?(full_size = false) target = |> OSnap_Websocket.send |> Lwt.map Response.parse |> Lwt.map (fun response -> - let error = - response.Response.error - |> Option.map (fun (error : Response.error) -> - `OSnap_CDP_Protocol_Error error.message) - |> Option.value ~default:(`OSnap_CDP_Protocol_Error "") - in - Option.to_result response.Response.result ~none:error) + let error = + response.Response.error + |> Option.map (fun (error : Response.error) -> + `OSnap_CDP_Protocol_Error error.message) + |> Option.value ~default:(`OSnap_CDP_Protocol_Error "") + in + Option.to_result response.Response.result ~none:error) in Lwt_result.return result.data ;; @@ -433,13 +433,13 @@ let clear_cookies target = |> OSnap_Websocket.send |> Lwt.map Response.parse |> Lwt.map (fun response -> - let error = - response.Response.error - |> Option.map (fun (error : Response.error) -> - `OSnap_CDP_Protocol_Error error.message) - |> Option.value ~default:(`OSnap_CDP_Protocol_Error "") - in - Option.to_result response.Response.result ~none:error) + let error = + response.Response.error + |> Option.map (fun (error : Response.error) -> + `OSnap_CDP_Protocol_Error error.message) + |> Option.value ~default:(`OSnap_CDP_Protocol_Error "") + in + Option.to_result response.Response.result ~none:error) in Lwt_result.return () ;; diff --git a/lib/OSnap_Browser/OSnap_Browser_Actions.mli b/lib/OSnap_Browser/OSnap_Browser_Actions.mli index 3b518d8..6b26c35 100644 --- a/lib/OSnap_Browser/OSnap_Browser_Actions.mli +++ b/lib/OSnap_Browser/OSnap_Browser_Actions.mli @@ -1,9 +1,9 @@ val get_document : OSnap_Browser_Target.target -> ( Cdp.Commands.DOM.GetDocument.Response.result - , [> `OSnap_CDP_Protocol_Error of string ] ) - result - Lwt.t + , [> `OSnap_CDP_Protocol_Error of string ] ) + result + Lwt.t val wait_for_network_idle : OSnap_Browser_Target.target -> loaderId:string -> unit Lwt.t @@ -18,55 +18,55 @@ val type_text -> text:string -> OSnap_Browser_Target.target -> ( unit - , [> `OSnap_CDP_Protocol_Error of string - | `OSnap_Selector_Not_Found of string - | `OSnap_Selector_Not_Visible of string - ] ) - Lwt_result.t + , [> `OSnap_CDP_Protocol_Error of string + | `OSnap_Selector_Not_Found of string + | `OSnap_Selector_Not_Visible of string + ] ) + Lwt_result.t val get_quads_all : document:Cdp.Commands.DOM.GetDocument.Response.result -> selector:string -> OSnap_Browser_Target.target -> ( ((float * float) * (float * float)) list - , [> `OSnap_CDP_Protocol_Error of string - | `OSnap_Selector_Not_Found of string - | `OSnap_Selector_Not_Visible of string - ] ) - Lwt_result.t + , [> `OSnap_CDP_Protocol_Error of string + | `OSnap_Selector_Not_Found of string + | `OSnap_Selector_Not_Visible of string + ] ) + Lwt_result.t val get_quads : document:Cdp.Commands.DOM.GetDocument.Response.result -> selector:string -> OSnap_Browser_Target.target -> ( (float * float) * (float * float) - , [> `OSnap_CDP_Protocol_Error of string - | `OSnap_Selector_Not_Found of string - | `OSnap_Selector_Not_Visible of string - ] ) - Lwt_result.t + , [> `OSnap_CDP_Protocol_Error of string + | `OSnap_Selector_Not_Found of string + | `OSnap_Selector_Not_Visible of string + ] ) + Lwt_result.t val mousemove : document:Cdp.Commands.DOM.GetDocument.Response.result -> to_:[< `Coordinates of Cdp.Types.number * Cdp.Types.number | `Selector of string ] -> OSnap_Browser_Target.target -> ( unit - , [> `OSnap_CDP_Protocol_Error of string - | `OSnap_Selector_Not_Found of string - | `OSnap_Selector_Not_Visible of string - ] ) - Lwt_result.t + , [> `OSnap_CDP_Protocol_Error of string + | `OSnap_Selector_Not_Found of string + | `OSnap_Selector_Not_Visible of string + ] ) + Lwt_result.t val click : document:Cdp.Commands.DOM.GetDocument.Response.result -> selector:string -> OSnap_Browser_Target.target -> ( unit - , [> `OSnap_CDP_Protocol_Error of string - | `OSnap_Selector_Not_Found of string - | `OSnap_Selector_Not_Visible of string - ] ) - Lwt_result.t + , [> `OSnap_CDP_Protocol_Error of string + | `OSnap_Selector_Not_Found of string + | `OSnap_Selector_Not_Visible of string + ] ) + Lwt_result.t val scroll : document:Cdp.Commands.DOM.GetDocument.Response.result @@ -74,11 +74,11 @@ val scroll -> px:int option -> OSnap_Browser_Target.target -> ( unit - , [> `OSnap_CDP_Protocol_Error of string - | `OSnap_Selector_Not_Found of string - | `OSnap_Selector_Not_Visible of string - ] ) - Lwt_result.t + , [> `OSnap_CDP_Protocol_Error of string + | `OSnap_Selector_Not_Found of string + | `OSnap_Selector_Not_Visible of string + ] ) + Lwt_result.t val set_size : width:Cdp.Types.number diff --git a/lib/OSnap_Browser/OSnap_Browser_Download.ml b/lib/OSnap_Browser/OSnap_Browser_Download.ml index bdf8e1c..24a498f 100644 --- a/lib/OSnap_Browser/OSnap_Browser_Download.ml +++ b/lib/OSnap_Browser/OSnap_Browser_Download.ml @@ -86,12 +86,11 @@ let cleanup_old_revisions () = let old_revisions = OSnap_Browser_Path.get_previous_revisions () in old_revisions |> List.iter (fun revision -> - match get_downloaded_revision revision with - | None -> () - | Some path -> - Printf.sprintf "Removing old chrome revision at path %s ..." path - |> print_endline; - FileUtil.rm ~recurse:true ~force:Force [ path ]) + match get_downloaded_revision revision with + | None -> () + | Some path -> + Printf.sprintf "Removing old chrome revision at path %s ..." path |> print_endline; + FileUtil.rm ~recurse:true ~force:Force [ path ]) ;; let download revision = diff --git a/lib/OSnap_Browser/OSnap_Browser_Launcher.ml b/lib/OSnap_Browser/OSnap_Browser_Launcher.ml index 9e3a602..65d7160 100644 --- a/lib/OSnap_Browser/OSnap_Browser_Launcher.ml +++ b/lib/OSnap_Browser/OSnap_Browser_Launcher.ml @@ -82,13 +82,13 @@ let make () = |> Websocket.send |> Lwt.map Response.parse |> Lwt.map (fun response -> - let error = - response.Response.error - |> Option.map (fun (error : Response.error) -> - `OSnap_CDP_Protocol_Error error.message) - |> Option.value ~default:`OSnap_CDP_Connection_Failed - in - Option.to_result response.Response.result ~none:error) + let error = + response.Response.error + |> Option.map (fun (error : Response.error) -> + `OSnap_CDP_Protocol_Error error.message) + |> Option.value ~default:`OSnap_CDP_Connection_Failed + in + Option.to_result response.Response.result ~none:error) in Lwt_result.return { ws = url; process; browserContextId = result.browserContextId } ;; diff --git a/lib/OSnap_Browser/OSnap_Browser_Launcher.mli b/lib/OSnap_Browser/OSnap_Browser_Launcher.mli index 85b26ca..facd97e 100644 --- a/lib/OSnap_Browser/OSnap_Browser_Launcher.mli +++ b/lib/OSnap_Browser/OSnap_Browser_Launcher.mli @@ -1,10 +1,10 @@ val make : unit -> ( OSnap_Browser_Types.t - , [> `OSnap_Chromium_Download_Failed - | `OSnap_CDP_Connection_Failed - | `OSnap_CDP_Protocol_Error of string - ] ) - Lwt_result.t + , [> `OSnap_Chromium_Download_Failed + | `OSnap_CDP_Connection_Failed + | `OSnap_CDP_Protocol_Error of string + ] ) + Lwt_result.t val shutdown : OSnap_Browser_Types.t -> unit diff --git a/lib/OSnap_Browser/OSnap_Browser_Target.ml b/lib/OSnap_Browser/OSnap_Browser_Target.ml index c7149a8..f6933dc 100644 --- a/lib/OSnap_Browser/OSnap_Browser_Target.ml +++ b/lib/OSnap_Browser/OSnap_Browser_Target.ml @@ -16,13 +16,13 @@ let enable_events t = |> Websocket.send |> Lwt.map Response.parse |> Lwt.map (fun response -> - let error = - response.Response.error - |> Option.map (fun (error : Response.error) -> - `OSnap_CDP_Protocol_Error error.message) - |> Option.value ~default:(`OSnap_CDP_Protocol_Error "") - in - Option.to_result response.Response.result ~none:error) + let error = + response.Response.error + |> Option.map (fun (error : Response.error) -> + `OSnap_CDP_Protocol_Error error.message) + |> Option.value ~default:(`OSnap_CDP_Protocol_Error "") + in + Option.to_result response.Response.result ~none:error) in let* _ = let open DOM.Enable in @@ -30,13 +30,13 @@ let enable_events t = |> Websocket.send |> Lwt.map Response.parse |> Lwt.map (fun response -> - let error = - response.Response.error - |> Option.map (fun (error : Response.error) -> - `OSnap_CDP_Protocol_Error error.message) - |> Option.value ~default:(`OSnap_CDP_Protocol_Error "") - in - Option.to_result response.Response.result ~none:error) + let error = + response.Response.error + |> Option.map (fun (error : Response.error) -> + `OSnap_CDP_Protocol_Error error.message) + |> Option.value ~default:(`OSnap_CDP_Protocol_Error "") + in + Option.to_result response.Response.result ~none:error) in let* _ = let open Page.SetLifecycleEventsEnabled in @@ -44,13 +44,13 @@ let enable_events t = |> Websocket.send |> Lwt.map Response.parse |> Lwt.map (fun response -> - let error = - response.Response.error - |> Option.map (fun (error : Response.error) -> - `OSnap_CDP_Protocol_Error error.message) - |> Option.value ~default:(`OSnap_CDP_Protocol_Error "") - in - Option.to_result response.Response.result ~none:error) + let error = + response.Response.error + |> Option.map (fun (error : Response.error) -> + `OSnap_CDP_Protocol_Error error.message) + |> Option.value ~default:(`OSnap_CDP_Protocol_Error "") + in + Option.to_result response.Response.result ~none:error) in Lwt_result.return () ;; @@ -69,13 +69,13 @@ let make browser = |> Websocket.send |> Lwt.map Response.parse |> Lwt.map (fun response -> - let error = - response.Response.error - |> Option.map (fun (error : Response.error) -> - `OSnap_CDP_Protocol_Error error.message) - |> Option.value ~default:(`OSnap_CDP_Protocol_Error "") - in - Option.to_result response.Response.result ~none:error) + let error = + response.Response.error + |> Option.map (fun (error : Response.error) -> + `OSnap_CDP_Protocol_Error error.message) + |> Option.value ~default:(`OSnap_CDP_Protocol_Error "") + in + Option.to_result response.Response.result ~none:error) in let*? { sessionId } = let open Cdp.Commands.Target.AttachToTarget in @@ -83,13 +83,13 @@ let make browser = |> Websocket.send |> Lwt.map Response.parse |> Lwt.map (fun response -> - let error = - response.Response.error - |> Option.map (fun (error : Response.error) -> - `OSnap_CDP_Protocol_Error error.message) - |> Option.value ~default:(`OSnap_CDP_Protocol_Error "") - in - Option.to_result response.Response.result ~none:error) + let error = + response.Response.error + |> Option.map (fun (error : Response.error) -> + `OSnap_CDP_Protocol_Error error.message) + |> Option.value ~default:(`OSnap_CDP_Protocol_Error "") + in + Option.to_result response.Response.result ~none:error) in let t = { targetId; sessionId } in let*? () = enable_events t in diff --git a/lib/OSnap_Browser/Zip.ml b/lib/OSnap_Browser/Zip.ml index 72f1d34..f05595c 100644 --- a/lib/OSnap_Browser/Zip.ml +++ b/lib/OSnap_Browser/Zip.ml @@ -147,19 +147,19 @@ let read_cd ic cd_entries cd_offset cd_bound = then raise (Failure "wrong file header in central directory"); if flags land 1 <> 0 then raise (Failure "encrypted entries not supported"); entries - := { name - ; lastmod_time - ; lastmod_date - ; extra - ; comment - ; compression_method - ; crc - ; uncompressed_size - ; compressed_size - ; is_directory = String.length name > 0 && name.[String.length name - 1] = '/' - ; file_offset = header_offset - } - :: !entries + := { name + ; lastmod_time + ; lastmod_date + ; extra + ; comment + ; compression_method + ; crc + ; uncompressed_size + ; compressed_size + ; is_directory = String.length name > 0 && name.[String.length name - 1] = '/' + ; file_offset = header_offset + } + :: !entries done; assert ( cd_bound = LargeFile.pos_in ic @@ -208,7 +208,7 @@ let goto_entry ifile e = let extra_len = read_2_bytes ic in if magic <> Int32.of_int 0x04034b50 then failwith "wrong local file header"; (* Could validate information read against directory entry, but - what the heck *) + what the heck *) LargeFile.seek_in ic (Int64.add e.file_offset (Int64.of_int (30 + filename_len + extra_len))); diff --git a/lib/OSnap_Cleanup.ml b/lib/OSnap_Cleanup.ml index 4e7dd7a..1821f4f 100644 --- a/lib/OSnap_Cleanup.ml +++ b/lib/OSnap_Cleanup.ml @@ -10,22 +10,22 @@ let cleanup ~config_path = let test_file_paths = tests |> List.map (fun (test : Config.Types.test) -> - test.sizes - |> List.filter_map (fun (size : Config.Types.size) -> - let Config.Types.{ width; height; _ } = size in - let filename = OSnap_Test.get_filename test.name width height in - let current_image_path = Filename.concat snapshot_dir filename in - let exists = Sys.file_exists current_image_path in - if exists then Some filename else None)) + test.sizes + |> List.filter_map (fun (size : Config.Types.size) -> + let Config.Types.{ width; height; _ } = size in + let filename = OSnap_Test.get_filename test.name width height in + let current_image_path = Filename.concat snapshot_dir filename in + let exists = Sys.file_exists current_image_path in + if exists then Some filename else None)) |> List.flatten in let files_to_delete = Sys.readdir snapshot_dir |> Array.to_list |> List.filter_map (fun file -> - if not (List.mem file test_file_paths) - then Some (Filename.concat snapshot_dir file) - else None) + if not (List.mem file test_file_paths) + then Some (Filename.concat snapshot_dir file) + else None) in let num_files_to_delete = List.length files_to_delete in let open Fmt in @@ -37,8 +37,8 @@ let cleanup ~config_path = (Printf.sprintf "Deleting %i files...\n" num_files_to_delete); files_to_delete |> List.iter (fun file -> - Sys.remove file; - Fmt.pr "%a @." (styled `Faint string) (Printf.sprintf "Deleted %s" file)); + Sys.remove file; + Fmt.pr "%a @." (styled `Faint string) (Printf.sprintf "Deleted %s" file)); Fmt.pr "\n%a @." (styled `Bold (styled `Green string)) "Done!") else Fmt.pr diff --git a/lib/OSnap_Config/OSnap_Config_Global.ml b/lib/OSnap_Config/OSnap_Config_Global.ml index 4a6e14e..dd267ee 100644 --- a/lib/OSnap_Config/OSnap_Config_Global.ml +++ b/lib/OSnap_Config/OSnap_Config_Global.ml @@ -9,7 +9,7 @@ module YAML = struct config |> Yaml.of_string |> Result.map_error (fun _ -> - `OSnap_Config_Parse_Error ("YAML could not be parsed", path)) + `OSnap_Config_Parse_Error ("YAML could not be parsed", path)) in let* base_url = yaml |> OSnap_Config_Utils.YAML.get_string ~path "baseUrl" in let* fullscreen = @@ -39,19 +39,19 @@ module YAML = struct let f = yaml |> Yaml.Util.find_exn "functions" in f |> Option.map (fun f -> - f - |> Yaml.Util.keys_exn - |> OSnap_Utils.List.map_until_exception (fun key -> - let* actions = - f - |> OSnap_Config_Utils.YAML.get_list_option - ~path - key - ~parser:(OSnap_Config_Utils.YAML.parse_action ~global_fns:[] ~path) - |> Result.map (Option.value ~default:[]) - |> Result.map List.flatten - in - (key, actions) |> Result.ok)) + f + |> Yaml.Util.keys_exn + |> OSnap_Utils.List.map_until_exception (fun key -> + let* actions = + f + |> OSnap_Config_Utils.YAML.get_list_option + ~path + key + ~parser:(OSnap_Config_Utils.YAML.parse_action ~global_fns:[] ~path) + |> Result.map (Option.value ~default:[]) + |> Result.map List.flatten + in + (key, actions) |> Result.ok)) |> Option.value ~default:(Result.ok []) in let* snapshot_directory = @@ -75,7 +75,7 @@ module YAML = struct yaml |> Yaml.Util.find "diffPixelColor" |> Result.map_error (function `Msg message -> - `OSnap_Config_Parse_Error (message, path)) + `OSnap_Config_Parse_Error (message, path)) |> Result.map (Option.map (fun colors -> let get_color = function @@ -90,7 +90,7 @@ module YAML = struct colors |> Yaml.Util.find "r" |> Result.map_error (function `Msg message -> - `OSnap_Config_Parse_Error (message, path)) + `OSnap_Config_Parse_Error (message, path)) |> Result.map (Option.map get_color) |> Result.map OSnap_Config_Utils.to_result_option |> Result.join @@ -100,7 +100,7 @@ module YAML = struct colors |> Yaml.Util.find "g" |> Result.map_error (function `Msg message -> - `OSnap_Config_Parse_Error (message, path)) + `OSnap_Config_Parse_Error (message, path)) |> Result.map (Option.map get_color) |> Result.map OSnap_Config_Utils.to_result_option |> Result.join @@ -110,7 +110,7 @@ module YAML = struct colors |> Yaml.Util.find "b" |> Result.map_error (function `Msg message -> - `OSnap_Config_Parse_Error (message, path)) + `OSnap_Config_Parse_Error (message, path)) |> Result.map (Option.map get_color) |> Result.map OSnap_Config_Utils.to_result_option |> Result.join @@ -126,8 +126,8 @@ module YAML = struct |> List.filter (fun (s : OSnap_Config_Types.size) -> Option.is_some s.name) |> OSnap_Utils.find_duplicates (fun (s : OSnap_Config_Types.size) -> s.name) |> List.map (fun (s : OSnap_Config_Types.size) -> - let name = Option.value s.name ~default:"" in - name) + let name = Option.value s.name ~default:"" in + name) in if List.length duplicates <> 0 then Result.error (`OSnap_Config_Duplicate_Size_Names duplicates) @@ -204,18 +204,18 @@ module JSON = struct | `Assoc assoc -> assoc |> OSnap_Utils.List.map_until_exception (fun (key, actions) -> - let* actions = - try - actions - |> Yojson.Basic.Util.to_list - |> OSnap_Utils.List.map_until_exception - (OSnap_Config_Utils.JSON.parse_action ~global_fns:[] ~path) - |> Result.map List.flatten - with - | Yojson.Basic.Util.Type_error (message, _) -> - Result.error (`OSnap_Config_Parse_Error (message, path)) - in - Result.ok (key, actions)) + let* actions = + try + actions + |> Yojson.Basic.Util.to_list + |> OSnap_Utils.List.map_until_exception + (OSnap_Config_Utils.JSON.parse_action ~global_fns:[] ~path) + |> Result.map List.flatten + with + | Yojson.Basic.Util.Type_error (message, _) -> + Result.error (`OSnap_Config_Parse_Error (message, path)) + in + Result.ok (key, actions)) | _ -> Result.error (`OSnap_Config_Parse_Error ("The functions option has to be an object.", path)) @@ -252,9 +252,9 @@ module JSON = struct | `List list -> list |> OSnap_Utils.List.map_until_exception (fun item -> - try Yojson.Basic.Util.to_string item |> Result.ok with - | Yojson.Basic.Util.Type_error (message, _) -> - Result.error (`OSnap_Config_Parse_Error (message, path))) + try Yojson.Basic.Util.to_string item |> Result.ok with + | Yojson.Basic.Util.Type_error (message, _) -> + Result.error (`OSnap_Config_Parse_Error (message, path))) | _ -> Result.ok [ "**/node_modules/**" ] with | Yojson.Basic.Util.Type_error (message, _) -> @@ -299,8 +299,8 @@ module JSON = struct |> List.filter (fun (s : OSnap_Config_Types.size) -> Option.is_some s.name) |> OSnap_Utils.find_duplicates (fun (s : OSnap_Config_Types.size) -> s.name) |> List.map (fun (s : OSnap_Config_Types.size) -> - let name = Option.value s.name ~default:"" in - name) + let name = Option.value s.name ~default:"" in + name) in if List.length duplicates <> 0 then Result.error (`OSnap_Config_Duplicate_Size_Names duplicates) @@ -328,9 +328,9 @@ let find config_names = let files = elements |> List.find_all (fun el -> - let path = OSnap_Utils.path_of_segments (el :: segments) in - let is_direcoty = path |> Sys.is_directory in - not is_direcoty) + let path = OSnap_Utils.path_of_segments (el :: segments) in + let is_direcoty = path |> Sys.is_directory in + not is_direcoty) in let found_file = files |> List.find_opt (fun file -> List.mem file config_names) in match found_file with diff --git a/lib/OSnap_Config/OSnap_Config_Global.mli b/lib/OSnap_Config/OSnap_Config_Global.mli index c5db0a3..6ab1a14 100644 --- a/lib/OSnap_Config/OSnap_Config_Global.mli +++ b/lib/OSnap_Config/OSnap_Config_Global.mli @@ -1,11 +1,11 @@ val init : config_path:string -> ( OSnap_Config_Types.global - , [> `OSnap_Config_Duplicate_Size_Names of string list - | `OSnap_Config_Global_Not_Found - | `OSnap_Config_Invalid of string * string - | `OSnap_Config_Parse_Error of string * string - | `OSnap_Config_Unsupported_Format of string - | `OSnap_Config_Undefined_Function of string * string - ] ) - result + , [> `OSnap_Config_Duplicate_Size_Names of string list + | `OSnap_Config_Global_Not_Found + | `OSnap_Config_Invalid of string * string + | `OSnap_Config_Parse_Error of string * string + | `OSnap_Config_Unsupported_Format of string + | `OSnap_Config_Undefined_Function of string * string + ] ) + result diff --git a/lib/OSnap_Config/OSnap_Config_Test.ml b/lib/OSnap_Config/OSnap_Config_Test.ml index 3b42a18..a30fb98 100644 --- a/lib/OSnap_Config/OSnap_Config_Test.ml +++ b/lib/OSnap_Config/OSnap_Config_Test.ml @@ -264,15 +264,15 @@ module YAML = struct config |> Yaml.of_string |> Result.map_error (fun _ -> - `OSnap_Config_Parse_Error ("YAML could not be parsed", path)) + `OSnap_Config_Parse_Error ("YAML could not be parsed", path)) in yaml |> (function - | `A lst -> Result.ok lst - | _ -> - Result.error - (`OSnap_Config_Parse_Error - ("A test file has to be an array of tests.", path))) + | `A lst -> Result.ok lst + | _ -> + Result.error + (`OSnap_Config_Parse_Error + ("A test file has to be an array of tests.", path))) |> Result.map (OSnap_Utils.List.map_until_exception (parse_single_test ~path global_config)) |> Result.join @@ -319,8 +319,8 @@ let find ?(root_path = "/") ?(pattern = "**/*.osnap.json") ?(ignore_patterns = [ (fun acc curr -> curr :: acc) [] |> OSnap_Utils.List.map_until_exception (fun path -> - let* format = OSnap_Config_Utils.get_format path in - Result.ok (path, format)) + let* format = OSnap_Config_Utils.get_format path in + Result.ok (path, format)) ;; let init config = @@ -334,9 +334,9 @@ let init config = let* tests = tests |> OSnap_Utils.List.map_until_exception (fun (path, test_format) -> - match test_format with - | OSnap_Config_Types.JSON -> JSON.parse config path - | OSnap_Config_Types.YAML -> YAML.parse config path) + match test_format with + | OSnap_Config_Types.JSON -> JSON.parse config path + | OSnap_Config_Types.YAML -> YAML.parse config path) |> Result.map List.flatten in let duplicates = diff --git a/lib/OSnap_Config/OSnap_Config_Test.mli b/lib/OSnap_Config/OSnap_Config_Test.mli index e13fb6c..e4a4e91 100644 --- a/lib/OSnap_Config/OSnap_Config_Test.mli +++ b/lib/OSnap_Config/OSnap_Config_Test.mli @@ -1,12 +1,12 @@ val init : OSnap_Config_Types.global -> ( OSnap_Config_Types.test list - , [> `OSnap_Config_Duplicate_Size_Names of string list - | `OSnap_Config_Duplicate_Tests of string list - | `OSnap_Config_Global_Invalid of string - | `OSnap_Config_Invalid of string * string - | `OSnap_Config_Parse_Error of string * string - | `OSnap_Config_Unsupported_Format of string - | `OSnap_Config_Undefined_Function of string * string - ] ) - result + , [> `OSnap_Config_Duplicate_Size_Names of string list + | `OSnap_Config_Duplicate_Tests of string list + | `OSnap_Config_Global_Invalid of string + | `OSnap_Config_Invalid of string * string + | `OSnap_Config_Parse_Error of string * string + | `OSnap_Config_Unsupported_Format of string + | `OSnap_Config_Undefined_Function of string * string + ] ) + result diff --git a/lib/OSnap_Config/OSnap_Config_Utils.ml b/lib/OSnap_Config/OSnap_Config_Utils.ml index 8163fc9..d16f76b 100644 --- a/lib/OSnap_Config/OSnap_Config_Utils.ml +++ b/lib/OSnap_Config/OSnap_Config_Utils.ml @@ -73,22 +73,22 @@ let collect_action let actions = global_fns |> List.find_map (function - | n, actions when n = name -> Some actions - | _ -> None) + | n, actions when n = name -> Some actions + | _ -> None) in (match actions with | None -> Result.error (`OSnap_Config_Undefined_Function (name, path)) | Some actions -> actions |> List.map (function - | OSnap_Config_Types.Scroll (a, _) -> - OSnap_Config_Types.Scroll (a, size_restriction) - | OSnap_Config_Types.Click (a, _) -> - OSnap_Config_Types.Click (a, size_restriction) - | OSnap_Config_Types.Type (a, b, _) -> - OSnap_Config_Types.Type (a, b, size_restriction) - | OSnap_Config_Types.Wait (t, _) -> - OSnap_Config_Types.Wait (t, size_restriction)) + | OSnap_Config_Types.Scroll (a, _) -> + OSnap_Config_Types.Scroll (a, size_restriction) + | OSnap_Config_Types.Click (a, _) -> + OSnap_Config_Types.Click (a, size_restriction) + | OSnap_Config_Types.Type (a, b, _) -> + OSnap_Config_Types.Type (a, b, size_restriction) + | OSnap_Config_Types.Wait (t, _) -> + OSnap_Config_Types.Wait (t, size_restriction)) |> Result.ok)) | action -> Result.error @@ -114,13 +114,13 @@ module JSON = struct size |> Yojson.Basic.Util.member "width" |> (function - | `Null -> - Result.error - (`OSnap_Config_Parse_Error - ( "defaultSize has an invalid format. \"width\" is required but not \ - provided!" - , path )) - | v -> Result.ok v) + | `Null -> + Result.error + (`OSnap_Config_Parse_Error + ( "defaultSize has an invalid format. \"width\" is required but not \ + provided!" + , path )) + | v -> Result.ok v) |> Result.map Yojson.Basic.Util.to_int with | Yojson.Basic.Util.Type_error (message, _) -> @@ -131,13 +131,13 @@ module JSON = struct size |> Yojson.Basic.Util.member "height" |> (function - | `Null -> - Result.error - (`OSnap_Config_Parse_Error - ( "defaultSize has an invalid format. \"height\" is required but not \ - provided!" - , path )) - | v -> Result.ok v) + | `Null -> + Result.error + (`OSnap_Config_Parse_Error + ( "defaultSize has an invalid format. \"height\" is required but not \ + provided!" + , path )) + | v -> Result.ok v) |> Result.map Yojson.Basic.Util.to_int with | Yojson.Basic.Util.Type_error (message, _) -> @@ -232,7 +232,7 @@ module YAML = struct obj |> Yaml.Util.find key |> Result.map_error (function `Msg message -> - `OSnap_Config_Parse_Error (message, path)) + `OSnap_Config_Parse_Error (message, path)) |> Result.map (Option.map (fun v -> match v with @@ -283,7 +283,7 @@ module YAML = struct let parser v = Yaml.Util.to_string v |> Result.map_error (function `Msg message -> - `OSnap_Config_Parse_Error (message, path)) + `OSnap_Config_Parse_Error (message, path)) in get_list_option ~path ~parser key obj ;; @@ -295,7 +295,7 @@ module YAML = struct |> Result.map to_result_option |> Result.join |> Result.map_error (function `Msg message -> - `OSnap_Config_Parse_Error (message, path)) + `OSnap_Config_Parse_Error (message, path)) ;; let get_string ~path ?(additional_error_message = "") key obj = @@ -324,7 +324,7 @@ module YAML = struct |> Result.map to_result_option |> Result.join |> Result.map_error (function `Msg message -> - `OSnap_Config_Parse_Error (message, path)) + `OSnap_Config_Parse_Error (message, path)) ;; let get_bool ~path ?(additional_error_message = "") key obj = @@ -374,7 +374,7 @@ module YAML = struct |> Result.join |> Result.map (Option.map Float.to_int) |> Result.map_error (function `Msg message -> - `OSnap_Config_Parse_Error (message, path)) + `OSnap_Config_Parse_Error (message, path)) ;; let parse_size ~path size = diff --git a/lib/OSnap_Diff/config/discover.ml b/lib/OSnap_Diff/config/discover.ml index b8f11da..4d1cc85 100644 --- a/lib/OSnap_Diff/config/discover.ml +++ b/lib/OSnap_Diff/config/discover.ml @@ -19,13 +19,12 @@ let main c = in new_pkg_config_path |> Option.map (fun new_pkg_config_path -> - let pkg_config_path = - match Sys.getenv_opt "PKG_CONFIG_PATH" with - | Some s -> s ^ ":" - | None -> "" - in - [ Printf.sprintf "PKG_CONFIG_PATH=%s%s" pkg_config_path new_pkg_config_path - ]) + let pkg_config_path = + match Sys.getenv_opt "PKG_CONFIG_PATH" with + | Some s -> s ^ ":" + | None -> "" + in + [ Printf.sprintf "PKG_CONFIG_PATH=%s%s" pkg_config_path new_pkg_config_path ]) | _ -> None in C.Process.run_capture_exn c ?env pkgcfg [ lib; "--variable=" ^ dir ] diff --git a/lib/OSnap_Diff/png_write/WritePng.ml b/lib/OSnap_Diff/png_write/WritePng.ml index 6d98d2d..6e351de 100644 --- a/lib/OSnap_Diff/png_write/WritePng.ml +++ b/lib/OSnap_Diff/png_write/WritePng.ml @@ -7,4 +7,4 @@ external write_png_bigarray -> int -> unit = "write_png_bigarray" - [@@noalloc] +[@@noalloc] diff --git a/lib/OSnap_Test/OSnap_Test.ml b/lib/OSnap_Test/OSnap_Test.ml index 11aa3be..6e93ee3 100644 --- a/lib/OSnap_Test/OSnap_Test.ml +++ b/lib/OSnap_Test/OSnap_Test.ml @@ -90,11 +90,11 @@ let get_ignore_regions ~document target size_name regions = let*? quads = target |> Browser.Actions.get_quads_all ~document ~selector in quads |> List.map (fun ((x1, y1), (x2, y2)) -> - let x1 = Int.of_float x1 in - let y1 = Int.of_float y1 in - let x2 = Int.of_float x2 in - let y2 = Int.of_float y2 in - (x1, y1), (x2, y2)) + let x1 = Int.of_float x1 in + let y1 = Int.of_float y1 in + let x2 = Int.of_float x2 in + let y2 = Int.of_float y2 in + (x1, y1), (x2, y2)) |> Lwt_result.return | Selector (selector, _) -> let*? (x1, y1), (x2, y2) = @@ -109,26 +109,25 @@ let get_ignore_regions ~document target size_name regions = let* regions = regions |> List.filter (fun region -> - match region, size_name with - | Coordinates (_a, _b, None), _ -> true - | Coordinates (_, _, Some _), None -> false - | Coordinates (_a, _b, Some size_restr), Some size_name -> - List.mem size_name size_restr - | Selector (_, Some _), None -> false - | Selector (_, Some size_restr), Some size_name -> List.mem size_name size_restr - | Selector (_selector, None), _ -> true - | SelectorAll (_, Some _), None -> false - | SelectorAll (_, Some size_restr), Some size_name -> - List.mem size_name size_restr - | SelectorAll (_selector, None), _ -> true) + match region, size_name with + | Coordinates (_a, _b, None), _ -> true + | Coordinates (_, _, Some _), None -> false + | Coordinates (_a, _b, Some size_restr), Some size_name -> + List.mem size_name size_restr + | Selector (_, Some _), None -> false + | Selector (_, Some size_restr), Some size_name -> List.mem size_name size_restr + | Selector (_selector, None), _ -> true + | SelectorAll (_, Some _), None -> false + | SelectorAll (_, Some size_restr), Some size_name -> List.mem size_name size_restr + | SelectorAll (_selector, None), _ -> true) |> Lwt_list.map_p get_ignore_region in regions |> List.filter_map (function - | Ok regions -> Some (Lwt_result.return regions) - | Error (`OSnap_Selector_Not_Found _s) -> None - | Error (`OSnap_Selector_Not_Visible _s) -> None - | Error (`OSnap_CDP_Protocol_Error _ as e) -> Some (Lwt_result.fail e)) + | Ok regions -> Some (Lwt_result.return regions) + | Error (`OSnap_Selector_Not_Found _s) -> None + | Error (`OSnap_Selector_Not_Visible _s) -> None + | Error (`OSnap_CDP_Protocol_Error _ as e) -> Some (Lwt_result.fail e)) |> Lwt_list.map_p_until_exception Fun.id |> Lwt_result.map List.flatten ;; @@ -149,9 +148,9 @@ let run (global_config : Config.Types.global) target test = let filename = get_filename test.name test.width test.height in let diff_filename = get_filename ~diff:true test.name test.width test.height in let url = global_config.base_url ^ test.url in - let base_snapshot = dirs.base ^ filename in - let updated_snapshot = dirs.updated ^ filename in - let diff_image = dirs.diff ^ diff_filename in + let base_snapshot = Filename.concat dirs.base filename in + let updated_snapshot = Filename.concat dirs.updated filename in + let diff_image = Filename.concat dirs.diff diff_filename in let*? () = target |> Browser.Actions.clear_cookies in let*? () = target diff --git a/lib/OSnap_Test/OSnap_Test.mli b/lib/OSnap_Test/OSnap_Test.mli index 277f715..92bf1b2 100644 --- a/lib/OSnap_Test/OSnap_Test.mli +++ b/lib/OSnap_Test/OSnap_Test.mli @@ -8,5 +8,5 @@ val run -> OSnap_Browser.Target.target -> Types.t -> ( Types.t - , [> `OSnap_CDP_Protocol_Error of string | `OSnap_FS_Error of string ] ) - Lwt_result.t + , [> `OSnap_CDP_Protocol_Error of string | `OSnap_FS_Error of string ] ) + Lwt_result.t diff --git a/lib/OSnap_Test/OSnap_Test_Printer.ml b/lib/OSnap_Test/OSnap_Test_Printer.ml index 1e72490..a50af17 100644 --- a/lib/OSnap_Test/OSnap_Test_Printer.ml +++ b/lib/OSnap_Test/OSnap_Test_Printer.ml @@ -196,18 +196,18 @@ let stats ~seconds results = Fmt.pr "\n%a\n@." (styled `Bold string) "Summary of failed tests:"; failed |> List.iter (function - | { name; width; height; result = Some (`Failed `Io); _ } -> - corrupted_message ~print_head:false ~name ~width ~height - | { name; width; height; result = Some (`Failed `Layout); _ } -> - layout_message ~print_head:false ~name ~width ~height - | { name - ; width - ; height - ; result = Some (`Failed (`Pixel (diffCount, diffPercentage))) - ; _ - } -> - diff_message ~print_head:false ~name ~width ~height ~diffCount ~diffPercentage - | _ -> ())); + | { name; width; height; result = Some (`Failed `Io); _ } -> + corrupted_message ~print_head:false ~name ~width ~height + | { name; width; height; result = Some (`Failed `Layout); _ } -> + layout_message ~print_head:false ~name ~width ~height + | { name + ; width + ; height + ; result = Some (`Failed (`Pixel (diffCount, diffPercentage))) + ; _ + } -> + diff_message ~print_head:false ~name ~width ~height ~diffCount ~diffPercentage + | _ -> ())); match failed with | [] -> Lwt_result.return () | _ -> Lwt_result.fail `OSnap_Test_Failure diff --git a/lib/OSnap_Test/OSnap_Test_Types.ml b/lib/OSnap_Test/OSnap_Test_Types.ml index c83477e..107c70e 100644 --- a/lib/OSnap_Test/OSnap_Test_Types.ml +++ b/lib/OSnap_Test/OSnap_Test_Types.ml @@ -16,5 +16,5 @@ type t = | `Passed | `Skipped ] - option - } \ No newline at end of file + option + } diff --git a/lib/OSnap_Utils/OSnap_Utils.ml b/lib/OSnap_Utils/OSnap_Utils.ml index 32da749..536bf5d 100644 --- a/lib/OSnap_Utils/OSnap_Utils.ml +++ b/lib/OSnap_Utils/OSnap_Utils.ml @@ -56,12 +56,12 @@ let find_duplicates get_key list = let hash = Hashtbl.create (List.length list) in list |> List.filter (fun item -> - let key = get_key item in - if Hashtbl.mem hash key - then true - else ( - Hashtbl.add hash key true; - false)) + let key = get_key item in + if Hashtbl.mem hash key + then true + else ( + Hashtbl.add hash key true; + false)) ;; let path_of_segments paths = @@ -104,8 +104,8 @@ module Lwt_list = struct let success, error = resolved |> List.partition_map (function - | Ok v -> Either.left v - | Error e -> Either.right e) + | Ok v -> Either.left v + | Error e -> Either.right e) in (match error with | [] -> loop (success @ acc) pending diff --git a/lib/OSnap_Websocket/OSnap_Websocket.ml b/lib/OSnap_Websocket/OSnap_Websocket.ml index 212b959..fec0c26 100644 --- a/lib/OSnap_Websocket/OSnap_Websocket.ml +++ b/lib/OSnap_Websocket/OSnap_Websocket.ml @@ -120,9 +120,9 @@ let listen ?(look_behind = true) ~event ~sessionId handler = then Hashtbl.find_all events key |> List.iter (fun event -> - handler event (fun () -> - Hashtbl.remove listeners key; - Hashtbl.remove events key)) + handler event (fun () -> + Hashtbl.remove listeners key; + Hashtbl.remove events key)) ;; let close () =