From 7358567e5526423b1b2c11fb93585f3642e4cb88 Mon Sep 17 00:00:00 2001 From: rand00 Date: Wed, 2 Feb 2022 22:59:32 +0100 Subject: [PATCH 01/21] Utils: Moved omd-helpers into Omd submodule here --- lib/utils.ml | 80 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 80 insertions(+) diff --git a/lib/utils.ml b/lib/utils.ml index b2a3f75..93ba6ad 100644 --- a/lib/utils.ml +++ b/lib/utils.ml @@ -44,3 +44,83 @@ let compare_pkgs p1 p2 = String_map.empty (Astring.String.cuts ~sep:"\n" p) in diff_map (parse_pkgs p1) (parse_pkgs p2) + +module Omd = struct + + let make_safe omd = + let rec safe_block = function + | Omd.Paragraph (attr, inline) -> + safe_inline inline + |> Option.map (fun inline -> Omd.Paragraph (attr, inline)) + | Omd.List (attr, typ, spacing, blocks) -> + let blocks = List.filter_map (fun b -> + let b = List.filter_map safe_block b in + if b = [] then None else Some b) + blocks + in + if blocks = [] then None else + Some (Omd.List (attr, typ, spacing, blocks)) + | Omd.Blockquote (attr, blocks) -> + let blocks = List.filter_map safe_block blocks in + if blocks = [] then None else + Some (Omd.Blockquote (attr, blocks)) + | Omd.Heading (attr, level, inline) -> + safe_inline inline + |> Option.map (fun inline -> Omd.Heading (attr, level, inline)) + | Omd.Html_block _ -> None + | Omd.Definition_list (attr, def_elts) -> + let def_elts = List.filter_map safe_def_elts def_elts in + if def_elts = [] then None else + Some (Omd.Definition_list (attr, def_elts)) + | Omd.Code_block _ + | Omd.Thematic_break _ as v -> Some v + and safe_def_elts { term ; defs } = + let defs = List.filter_map safe_inline defs in + safe_inline term + |> Option.map (fun term -> { Omd.term ; defs }) + and safe_inline = function + | Concat (attr, inline) -> + Some (Concat (attr, List.filter_map safe_inline inline)) + | Emph (attr, inline) -> + safe_inline inline + |> Option.map (fun inline -> Omd.Emph (attr, inline)) + | Strong (attr, inline) -> + safe_inline inline + |> Option.map (fun inline -> Omd.Strong (attr, inline)) + | Link (attr, link) -> + begin match safe_link link with + | `No_label | `Relative -> safe_inline link.Omd.label + | `Link l -> Some (Omd.Link (attr, l)) + end + | Image (attr, link) -> + begin match safe_link link with + | `No_label | `Relative -> None + | `Link l -> Some (Omd.Image (attr, l)) + end + | Html _ -> None + | Text _ + | Code _ + | Hard_break _ + | Soft_break _ as v -> Some v + and safe_link ({ label ; destination ; _ } as l) = + let absolute_link = + String.(length destination >= 2 && equal (sub destination 0 2) "//") || + String.(length destination >= 7 && equal (sub destination 0 7) "http://") || + String.(length destination >= 8 && equal (sub destination 0 8) "https://") + in + if absolute_link then + match safe_inline label with + | None -> `No_label + | Some label -> `Link { l with label } + else + `Relative + in + List.filter_map safe_block omd + + let html_of_string markdown = + markdown + |> Omd.of_string + |> make_safe + |> Omd.to_html + +end From f40a081198ebc061d558c1f4ebd10eb89dae4cdc Mon Sep 17 00:00:00 2001 From: rand00 Date: Wed, 2 Feb 2022 23:00:01 +0100 Subject: [PATCH 02/21] test/markdown_to_html.ml: Usage of Utils.Omd --- test/markdown_to_html.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/markdown_to_html.ml b/test/markdown_to_html.ml index bfabe0f..4ad62ce 100644 --- a/test/markdown_to_html.ml +++ b/test/markdown_to_html.ml @@ -1,4 +1,4 @@ -let markdown_to_html = Builder_web__Views.markdown_to_html +let markdown_to_html = Builder_web__Utils.Omd.html_of_string let test_simple () = let markdown = {|# Hello world|} in From c17802d84fc101ce1b3dbcea98423bfa3abd8e4e Mon Sep 17 00:00:00 2001 From: rand00 Date: Wed, 2 Feb 2022 23:03:16 +0100 Subject: [PATCH 03/21] Views++: Factored Job.Build to Job_build + Renamed Builder to Builds to avoid collision with lib --- lib/builder_web.ml | 8 +- lib/views.ml | 477 +++++++++++++++++++-------------------------- 2 files changed, 206 insertions(+), 279 deletions(-) diff --git a/lib/builder_web.ml b/lib/builder_web.ml index 1ce8fda..e9f675e 100644 --- a/lib/builder_web.ml +++ b/lib/builder_web.ml @@ -100,7 +100,7 @@ let dream_svg ?status ?code ?headers body = let add_routes datadir = let datadir_global = Dream.new_global ~name:"datadir" (fun () -> datadir) in - let builder req = + let builds req = Dream.sql req Model.jobs_with_section_synopsis |> if_error "Error getting jobs" ~log:(fun e -> Log.warn (fun m -> m "Error getting jobs: %a" pp_error e)) @@ -126,7 +126,7 @@ let add_routes datadir = |> if_error "Error getting jobs" ~log:(fun e -> Log.warn (fun m -> m "Error getting jobs: %a" pp_error e)) >>= fun jobs -> - Views.builder jobs |> string_of_html |> Dream.html |> Lwt_result.ok + Views.Builds.make jobs |> string_of_html |> Dream.html |> Lwt_result.ok in let job req = @@ -279,7 +279,7 @@ let add_routes datadir = |> if_error "Error getting job build" ~log:(fun e -> Log.warn (fun m -> m "Error getting job build: %a" pp_error e)) >>= fun (build, artifacts, same_input_same_output, different_input_same_output, same_input_different_output, latest, next, previous) -> - Views.Job.Build.make + Views.Job_build.make ~name:job_name ~build ~artifacts @@ -493,7 +493,7 @@ let add_routes datadir = let w f req = or_error_response (f req) in Dream.router [ - Dream.get "/" (w builder); + Dream.get "/" (w builds); Dream.get "/job/:job/" (w job); Dream.get "/job/:job/failed/" (w job_with_failed); Dream.get "/job/:job/build/latest/**" (w redirect_latest); diff --git a/lib/views.ml b/lib/views.ml index 51c1e8f..2394483 100644 --- a/lib/views.ml +++ b/lib/views.ml @@ -155,152 +155,79 @@ let artifact ?(basename=false) job_name build { Builder_db.filepath; localpath = txtf " (%a)" Fmt.byte_size size; ] +module Builds = struct - -let builder section_job_map = - layout ~title:"Reproducible OPAM builds" - ([ h1 [txt "Reproducible OPAM builds"]; - p [ txt "This website offers binary MirageOS unikernels and supplementary OS packages." ]; - p [ txt {|Following is a list of jobs that are built daily. A persistent link to the latest successful build is available as /job/*jobname*/build/latest/. All builds can be reproduced with |} ; - a ~a:[a_href "https://github.com/roburio/orb/"] [txt "orb"]; - txt ". The builds are scheduled and executed by "; - a ~a:[a_href "https://github.com/roburio/builder/"] [txt "builder"]; - txt ". The web interface is "; - a ~a:[a_href "https://git.robur.io/robur/builder-web/"] [txt "builder-web"]; - txt ". Contact team@robur.coop if you have any questions or suggestions."; - ]; - form ~a:[a_action "/hash"; a_method `Get] - [ - label [ - txt "Search artifact by SHA256"; - br (); - input ~a:[ - a_input_type `Search; - a_id "sha256"; - a_name "sha256"; - ] (); - ]; - input ~a:[ - a_input_type `Submit; - a_value "Search"; - ] (); - ]; - ] @ + let make section_job_map = + layout ~title:"Reproducible OPAM builds" + ([ h1 [txt "Reproducible OPAM builds"]; + p [ txt "This website offers binary MirageOS unikernels and supplementary OS packages." ]; + p [ txt {|Following is a list of jobs that are built daily. A persistent link to the latest successful build is available as /job/*jobname*/build/latest/. All builds can be reproduced with |} ; + a ~a:[a_href "https://github.com/roburio/orb/"] [txt "orb"]; + txt ". The builds are scheduled and executed by "; + a ~a:[a_href "https://github.com/roburio/builder/"] [txt "builder"]; + txt ". The web interface is "; + a ~a:[a_href "https://git.robur.io/robur/builder-web/"] [txt "builder-web"]; + txt ". Contact team@robur.coop if you have any questions or suggestions."; + ]; + form ~a:[a_action "/hash"; a_method `Get] + [ + label [ + txt "Search artifact by SHA256"; + br (); + input ~a:[ + a_input_type `Search; + a_id "sha256"; + a_name "sha256"; + ] (); + ]; + input ~a:[ + a_input_type `Submit; + a_value "Search"; + ] (); + ]; + ] @ Utils.String_map.fold (fun section jobs acc -> acc @ [ h2 [ txt section ]; ul (List.map (fun (job_name, synopsis, platform_builds) -> - li ([ - a ~a:[a_href ("job/" ^ job_name ^ "/")] [txt job_name]; - br (); - txt (Option.value ~default:"" synopsis); - br () - ] @ - List.flatten - (List.map (fun (platform, latest_build, latest_artifact) -> + li ([ + a ~a:[a_href ("job/" ^ job_name ^ "/")] [txt job_name]; + br (); + txt (Option.value ~default:"" synopsis); + br () + ] @ + List.flatten + (List.map (fun (platform, latest_build, latest_artifact) -> [ check_icon latest_build.Builder_db.Build.result; txt " "; a ~a:[Fmt.kstr a_href "job/%s/%a" job_name pp_platform_query (Some platform)][txt platform]; txt " "; a ~a:[Fmt.kstr a_href "job/%s/build/%a/" job_name Uuidm.pp - latest_build.Builder_db.Build.uuid] + latest_build.Builder_db.Build.uuid] [txtf "%a" pp_ptime latest_build.Builder_db.Build.start]; txt " "; ] @ (match latest_artifact with - | Some main_binary -> - artifact ~basename:true job_name latest_build main_binary - | None -> - [ txtf "Build failure: %a" Builder.pp_execution_result - latest_build.Builder_db.Build.result ] + | Some main_binary -> + artifact ~basename:true job_name latest_build main_binary + | None -> + [ txtf "Build failure: %a" Builder.pp_execution_result + latest_build.Builder_db.Build.result ] ) @ [ br () ]) - platform_builds) - )) - jobs) + platform_builds) + )) + jobs) ]) - section_job_map - [] @ + section_job_map + [] @ [ p [ - txt "View the latest failed builds "; - a ~a:[a_href "/failed-builds/"] - [txt "here"]; - txt "." - ]]) + txt "View the latest failed builds "; + a ~a:[a_href "/failed-builds/"] + [txt "here"]; + txt "." + ]]) -let safe_omd omd = - let rec safe_block = function - | Omd.Paragraph (attr, inline) -> - safe_inline inline - |> Option.map (fun inline -> Omd.Paragraph (attr, inline)) - | Omd.List (attr, typ, spacing, blocks) -> - let blocks = List.filter_map (fun b -> - let b = List.filter_map safe_block b in - if b = [] then None else Some b) - blocks - in - if blocks = [] then None else - Some (Omd.List (attr, typ, spacing, blocks)) - | Omd.Blockquote (attr, blocks) -> - let blocks = List.filter_map safe_block blocks in - if blocks = [] then None else - Some (Omd.Blockquote (attr, blocks)) - | Omd.Heading (attr, level, inline) -> - safe_inline inline - |> Option.map (fun inline -> Omd.Heading (attr, level, inline)) - | Omd.Html_block _ -> None - | Omd.Definition_list (attr, def_elts) -> - let def_elts = List.filter_map safe_def_elts def_elts in - if def_elts = [] then None else - Some (Omd.Definition_list (attr, def_elts)) - | Omd.Code_block _ - | Omd.Thematic_break _ as v -> Some v - and safe_def_elts { term ; defs } = - let defs = List.filter_map safe_inline defs in - safe_inline term - |> Option.map (fun term -> { Omd.term ; defs }) - and safe_inline = function - | Concat (attr, inline) -> - Some (Concat (attr, List.filter_map safe_inline inline)) - | Emph (attr, inline) -> - safe_inline inline - |> Option.map (fun inline -> Omd.Emph (attr, inline)) - | Strong (attr, inline) -> - safe_inline inline - |> Option.map (fun inline -> Omd.Strong (attr, inline)) - | Link (attr, link) -> - begin match safe_link link with - | `No_label | `Relative -> safe_inline link.Omd.label - | `Link l -> Some (Omd.Link (attr, l)) - end - | Image (attr, link) -> - begin match safe_link link with - | `No_label | `Relative -> None - | `Link l -> Some (Omd.Image (attr, l)) - end - | Html _ -> None - | Text _ - | Code _ - | Hard_break _ - | Soft_break _ as v -> Some v - and safe_link ({ label ; destination ; _ } as l) = - let absolute_link = - String.(length destination >= 2 && equal (sub destination 0 2) "//") || - String.(length destination >= 7 && equal (sub destination 0 7) "http://") || - String.(length destination >= 8 && equal (sub destination 0 8) "https://") - in - if absolute_link then - match safe_inline label with - | None -> `No_label - | Some label -> `Link { l with label } - else - `Relative - in - List.filter_map safe_block omd - -let markdown_to_html data = - let omd = Omd.of_string data in - let omd = safe_omd omd in - Omd.to_html omd +end module Job = struct @@ -313,7 +240,7 @@ module Job = struct [ h2 ~a:[a_id "readme"] [txt "README"]; a ~a:[a_href "#builds"] [txt "Skip to builds"]; - Unsafe.data (markdown_to_html data) + Unsafe.data (Utils.Omd.html_of_string data) ])) @ [ h2 ~a:[a_id "builds"] [txt "Builds"]; @@ -340,104 +267,106 @@ module Job = struct p [ txt "Including failed builds " ; a ~a:[a_href "failed/"] [txt "here"] ; txt "." ] ]) +end + +module Job_build = struct + let contains_debug_bin artifacts = let check f = Fpath.has_ext "debug" f.Builder_db.filepath in List.exists check artifacts - module Build = struct - - let make_build_info - ~name - ~delta - ~(build:Builder_db.Build.t) (* ({ Builder_db.Build.uuid; start; finish; result; platform; _ } as build) *) - ~artifacts - ~same_input_same_output - ~different_input_same_output - ~same_input_different_output - ~latest ~next ~previous - = - [ - h2 ~a:[a_id "build"] [txtf "Build %a" pp_ptime build.start]; - p [txtf "Built on platform %s" build.platform ]; - p [txtf "Build took %a." Ptime.Span.pp delta ]; - p [txtf "Execution result: %a." Builder.pp_execution_result build.result]; - h3 [txt "Build info"]; - ul [ - li [ a ~a:[Fmt.kstr a_href "/job/%s/build/%a/console" name Uuidm.pp build.uuid] - [txt "Console output"]; - ]; - li [ a ~a:[Fmt.kstr a_href "/job/%s/build/%a/script" name Uuidm.pp build.uuid] - [txt "Build script"]; - ] + let make_build_info + ~name + ~delta + ~(build:Builder_db.Build.t) (* ({ Builder_db.Build.uuid; start; finish; result; platform; _ } as build) *) + ~artifacts + ~same_input_same_output + ~different_input_same_output + ~same_input_different_output + ~latest ~next ~previous + = + [ + h2 ~a:[a_id "build"] [txtf "Build %a" pp_ptime build.start]; + p [txtf "Built on platform %s" build.platform ]; + p [txtf "Build took %a." Ptime.Span.pp delta ]; + p [txtf "Execution result: %a." Builder.pp_execution_result build.result]; + h3 [txt "Build info"]; + ul [ + li [ a ~a:[Fmt.kstr a_href "/job/%s/build/%a/console" name Uuidm.pp build.uuid] + [txt "Console output"]; ]; - h3 [txt "Build artifacts"]; - dl (List.concat_map - (fun { Builder_db.filepath; localpath=_; sha256; size } -> - let (`Hex sha256_hex) = Hex.of_cstruct sha256 in - [ - dt [a - ~a:[Fmt.kstr a_href "f/%a" Fpath.pp filepath] - [code [txtf "%a" Fpath.pp filepath]]]; - dd [ - code [txt "SHA256:"; txt sha256_hex]; - txtf " (%a)" Fmt.byte_size size; - ]; - ]) - artifacts); - h3 [ txtf "Reproduced by %d builds" (List.length (same_input_same_output @ different_input_same_output))] ; - ul - ((List.map (fun { Builder_db.Build.start ; uuid ; platform ; _ } -> + li [ a ~a:[Fmt.kstr a_href "/job/%s/build/%a/script" name Uuidm.pp build.uuid] + [txt "Build script"]; + ] + ]; + h3 [txt "Build artifacts"]; + dl (List.concat_map + (fun { Builder_db.filepath; localpath=_; sha256; size } -> + let (`Hex sha256_hex) = Hex.of_cstruct sha256 in + [ + dt [a + ~a:[Fmt.kstr a_href "f/%a" Fpath.pp filepath] + [code [txtf "%a" Fpath.pp filepath]]]; + dd [ + code [txt "SHA256:"; txt sha256_hex]; + txtf " (%a)" Fmt.byte_size size; + ]; + ]) + artifacts); + h3 [ txtf "Reproduced by %d builds" (List.length (same_input_same_output @ different_input_same_output))] ; + ul + ((List.map (fun { Builder_db.Build.start ; uuid ; platform ; _ } -> + li [ + txtf "on %s, same input, " platform; + a ~a:[Fmt.kstr a_href "/job/%s/build/%a/" name Uuidm.pp uuid] + [txtf "%a" pp_ptime start] + ]) + same_input_same_output) @ + List.map (fun { Builder_db.Build.start ; uuid = other_uuid ; platform ; _ } -> + li [ + txtf "on %s, different input, " platform; + a ~a:[Fmt.kstr a_href "/compare/%a/%a/" + Uuidm.pp other_uuid Uuidm.pp build.uuid] + [txtf "%a" pp_ptime start] + ]) + different_input_same_output) + ] + @ (if same_input_different_output = [] then + [] + else + [ h3 [txt "Same input, different output (not reproducible!)"]; + ul ( + List.map (fun { Builder_db.Build.start ; uuid = other_uuid ; platform ; _ } -> li [ - txtf "on %s, same input, " platform; - a ~a:[Fmt.kstr a_href "/job/%s/build/%a/" name Uuidm.pp uuid] + txtf "on %s, " platform ; + a ~a:[Fmt.kstr a_href "/compare/%a/%a/" Uuidm.pp other_uuid Uuidm.pp build.uuid] [txtf "%a" pp_ptime start] ]) - same_input_same_output) @ - List.map (fun { Builder_db.Build.start ; uuid = other_uuid ; platform ; _ } -> - li [ - txtf "on %s, different input, " platform; - a ~a:[Fmt.kstr a_href "/compare/%a/%a/" - Uuidm.pp other_uuid Uuidm.pp build.uuid] - [txtf "%a" pp_ptime start] - ]) - different_input_same_output) - ] - @ (if same_input_different_output = [] then - [] - else - [ h3 [txt "Same input, different output (not reproducible!)"]; - ul ( - List.map (fun { Builder_db.Build.start ; uuid = other_uuid ; platform ; _ } -> - li [ - txtf "on %s, " platform ; - a ~a:[Fmt.kstr a_href "/compare/%a/%a/" Uuidm.pp other_uuid Uuidm.pp build.uuid] - [txtf "%a" pp_ptime start] - ]) - same_input_different_output) + same_input_different_output) + ] + ) + @ [ + h3 [txt "Comparisons with other builds on the same platform"]; + let opt_build (ctx, build') = + match build' with + | Some b when not (Uuidm.equal build.uuid b.Builder_db.Build.uuid) -> + [ li [ txt ctx; + a ~a:[Fmt.kstr a_href "/compare/%a/%a/" + Uuidm.pp b.uuid Uuidm.pp build.uuid] + [txtf "%a" pp_ptime b.start]] ] - ) - @ [ - h3 [txt "Comparisons with other builds on the same platform"]; - let opt_build (ctx, build') = - match build' with - | Some b when not (Uuidm.equal build.uuid b.Builder_db.Build.uuid) -> - [ li [ txt ctx; - a ~a:[Fmt.kstr a_href "/compare/%a/%a/" - Uuidm.pp b.uuid Uuidm.pp build.uuid] - [txtf "%a" pp_ptime b.start]] - ] - | _ -> [] - in - ul - (List.concat_map opt_build - [ ("Latest build ", latest) ; - ("Later build with different output ", next) ; - ("Earlier build with different output ", previous) ]) - ] + | _ -> [] + in + ul + (List.concat_map opt_build + [ ("Latest build ", latest) ; + ("Later build with different output ", next) ; + ("Earlier build with different output ", previous) ]) + ] - let viz_style_deps = " + let viz_style_deps = " width: 46em; height: 45.4em; max-width: 100%; @@ -446,7 +375,7 @@ module Job = struct min-height: 39em; " - let viz_style_treemap = " + let viz_style_treemap = " width: 46em; height: 48.4em; max-width: 100%; @@ -455,80 +384,78 @@ module Job = struct min-height: 41em; " - let make_viz_section ~name ~artifacts ~uuid = - [ - (* [ h3 [txt "Analysis"] ]; *) - [ p [ - let src = Fmt.str "/job/%s/build/%a/vizdependencies" name Uuidm.pp uuid in - iframe ~a:[ - a_src src; - a_title "Opam dependencies"; - a_style viz_style_deps - ] [] - ]]; - if not @@ contains_debug_bin artifacts then [] else [ - p [ - let src = Fmt.str "/job/%s/build/%a/viztreemap" name Uuidm.pp uuid in - iframe ~a:[ - a_src src; - a_title "Binary dissection"; - a_style viz_style_treemap - ] [] - ]]; - ] |> List.flatten + let make_viz_section ~name ~artifacts ~uuid = + [ + (* [ h3 [txt "Analysis"] ]; *) + [ p [ + let src = Fmt.str "/job/%s/build/%a/vizdependencies" name Uuidm.pp uuid in + iframe ~a:[ + a_src src; + a_title "Opam dependencies"; + a_style viz_style_deps + ] [] + ]]; + if not @@ contains_debug_bin artifacts then [] else [ + p [ + let src = Fmt.str "/job/%s/build/%a/viztreemap" name Uuidm.pp uuid in + iframe ~a:[ + a_src src; + a_title "Binary dissection"; + a_style viz_style_treemap + ] [] + ]]; + ] |> List.flatten - let make + let make + ~name + ~(build:Builder_db.Build.t) + ~artifacts + ~same_input_same_output + ~different_input_same_output + ~same_input_different_output + ~latest ~next ~previous + = + let delta = Ptime.diff build.finish build.start in + let right_column = make_viz_section ~name ~artifacts ~uuid:build.uuid in + let left_column = + make_build_info ~name - ~(build:Builder_db.Build.t) + ~delta + ~build ~artifacts ~same_input_same_output ~different_input_same_output ~same_input_different_output ~latest ~next ~previous - = - let delta = Ptime.diff build.finish build.start in - let right_column = make_viz_section ~name ~artifacts ~uuid:build.uuid in - let left_column = - make_build_info - ~name - ~delta - ~build - ~artifacts - ~same_input_same_output - ~different_input_same_output - ~same_input_different_output - ~latest ~next ~previous - in - let style_grid = a_style "display: flex; " in - let style_grid_container = a_style "\ + in + let style_grid = a_style "display: flex; " in + let style_grid_container = a_style "\ display: flex; align-items: center; justify-content: center; min-width: 83em; " - in - let style_col_container = a_style "" in - let style_col_left = a_style "width: 45em; min-width: 43em; padding-left: 2%" in - let style_col_right = a_style "width: 50%" in - let body = [ - div ~a:[ style_grid_container ] [ - div ~a:[ style_col_container ] [ - h1 [txtf "Job %s" name]; - div ~a:[ style_grid ] [ - (* div ~a:[ style_col_padding ] []; *) - div ~a:[ style_col_left ] left_column; - div ~a:[ style_col_right ] right_column - ] + in + let style_col_container = a_style "" in + let style_col_left = a_style "width: 45em; min-width: 43em; padding-left: 2%" in + let style_col_right = a_style "width: 50%" in + let body = [ + div ~a:[ style_grid_container ] [ + div ~a:[ style_col_container ] [ + h1 [txtf "Job %s" name]; + div ~a:[ style_grid ] [ + (* div ~a:[ style_col_padding ] []; *) + div ~a:[ style_col_left ] left_column; + div ~a:[ style_col_right ] right_column ] ] ] - in - layout - ~nav:(`Build (name, build)) - ~title:(Fmt.str "Job %s %a" name pp_ptime build.start) - body - - end + ] + in + layout + ~nav:(`Build (name, build)) + ~title:(Fmt.str "Job %s %a" name pp_ptime build.start) + body end From ae5c5cb67d579d1ede2af4d6ca17494d27acac9e Mon Sep 17 00:00:00 2001 From: rand00 Date: Wed, 2 Feb 2022 23:27:25 +0100 Subject: [PATCH 04/21] Views: Using ocp-indent to indent everything consistently + fixed code aesthetics (80 char rule etc.) --- lib/views.ml | 374 ++++++++++++++++++++++++++++++--------------------- 1 file changed, 224 insertions(+), 150 deletions(-) diff --git a/lib/views.ml b/lib/views.ml index 2394483..1e0f837 100644 --- a/lib/views.ml +++ b/lib/views.ml @@ -29,8 +29,10 @@ type nav = [ | `Comparison of (string * Builder_db.Build.t) * (string * Builder_db.Build.t) ] -let pp_platform = Fmt.(option ~none:(any "") (append (any "on ") string)) -let pp_platform_query = Fmt.(option ~none:(any "") (append (any "?platform=") string)) +let pp_platform = + Fmt.(option ~none:(any "") (append (any "on ") string)) +let pp_platform_query = + Fmt.(option ~none:(any "") (append (any "?platform=") string)) let static_css = Tyxml.Html.Unsafe.data {| body { @@ -89,14 +91,28 @@ let layout ?include_static_css ?nav:(nav_=`Default) ~title:title_ body_ = | `Default -> to_nav [txt "Home", "/"] | `Job (job_name, platform) -> - to_nav [txt "Home", "/"; txtf "Job %s" job_name, Fmt.str "/job/%s/" job_name ; txtf "%a" pp_platform platform, Fmt.str "/job/%s/%a" job_name pp_platform_query platform ] + to_nav [ + txt "Home", "/"; + txtf "Job %s" job_name, Fmt.str "/job/%s/" job_name ; + ( + txtf "%a" pp_platform platform, + Fmt.str "/job/%s/%a" job_name pp_platform_query platform + ) + ] | `Build (job_name, build) -> to_nav [ txt "Home", "/"; txtf "Job %s" job_name, Fmt.str "/job/%s/" job_name; - txtf "%a" pp_platform (Some build.Builder_db.Build.platform), Fmt.str "/job/%s/%a" job_name pp_platform_query (Some build.Builder_db.Build.platform); + ( + txtf "%a" pp_platform (Some build.Builder_db.Build.platform), + Fmt.str "/job/%s/%a" + job_name + pp_platform_query (Some build.Builder_db.Build.platform) + ); txtf "Build %a" pp_ptime build.Builder_db.Build.start, - Fmt.str "/job/%s/build/%a/" job_name Uuidm.pp build.Builder_db.Build.uuid; + Fmt.str "/job/%s/build/%a/" + job_name + Uuidm.pp build.Builder_db.Build.uuid; ] | `Comparison ((job_left, build_left), (job_right, build_right)) -> to_nav [ @@ -104,7 +120,9 @@ let layout ?include_static_css ?nav:(nav_=`Default) ~title:title_ body_ = txtf "Comparison between %s@%a and %s@%a" job_left pp_ptime build_left.Builder_db.Build.start job_right pp_ptime build_right.Builder_db.Build.start, - Fmt.str "/compare/%a/%a/" Uuidm.pp build_left.uuid Uuidm.pp build_right.uuid; + Fmt.str "/compare/%a/%a/" + Uuidm.pp build_left.uuid + Uuidm.pp build_right.uuid; ] in (*> Note: Last declared CSS wins - so one can override here*) @@ -112,7 +130,7 @@ let layout ?include_static_css ?nav:(nav_=`Default) ~title:title_ body_ = in html (head (title (txt title_)) - [style ~a:[a_mime_type "text/css"] static_css]) + [style ~a:[a_mime_type "text/css"] static_css]) (body [ breadcrumb; @@ -130,10 +148,10 @@ let toggleable ?(hidden=true) id description content = [txt description]; input ~a:(checked @ [ - a_input_type `Checkbox; - a_id id; - a_style "display: none;"; - ]) (); + a_input_type `Checkbox; + a_id id; + a_style "display: none;"; + ]) (); div ~a:[ a_class ["toggleable"] @@ -141,15 +159,24 @@ let toggleable ?(hidden=true) id description content = content; ] -let artifact ?(basename=false) job_name build { Builder_db.filepath; localpath = _; sha256; size } = +let artifact + ?(basename=false) + job_name + build + { Builder_db.filepath; localpath = _; sha256; size } + = + let artifact_link = + Fmt.str "/job/%s/build/%a/f/%a" + job_name + Uuidm.pp build.Builder_db.Build.uuid + Fpath.pp filepath + in [ - a ~a:[a_href (Fmt.str "/job/%s/build/%a/f/%a" - job_name - Uuidm.pp build.Builder_db.Build.uuid - Fpath.pp filepath)] - [if basename - then txt (Fpath.basename filepath) - else txtf "%a" Fpath.pp filepath]; + a ~a:[a_href artifact_link] + [ + if basename then txt (Fpath.basename filepath) + else txtf "%a" Fpath.pp filepath + ]; txt " "; code [txtf "SHA256:%a" Hex.pp (Hex.of_cstruct sha256)]; txtf " (%a)" Fmt.byte_size size; @@ -159,33 +186,40 @@ module Builds = struct let make section_job_map = layout ~title:"Reproducible OPAM builds" - ([ h1 [txt "Reproducible OPAM builds"]; - p [ txt "This website offers binary MirageOS unikernels and supplementary OS packages." ]; - p [ txt {|Following is a list of jobs that are built daily. A persistent link to the latest successful build is available as /job/*jobname*/build/latest/. All builds can be reproduced with |} ; - a ~a:[a_href "https://github.com/roburio/orb/"] [txt "orb"]; - txt ". The builds are scheduled and executed by "; - a ~a:[a_href "https://github.com/roburio/builder/"] [txt "builder"]; - txt ". The web interface is "; - a ~a:[a_href "https://git.robur.io/robur/builder-web/"] [txt "builder-web"]; - txt ". Contact team@robur.coop if you have any questions or suggestions."; - ]; - form ~a:[a_action "/hash"; a_method `Get] - [ - label [ - txt "Search artifact by SHA256"; - br (); - input ~a:[ - a_input_type `Search; - a_id "sha256"; - a_name "sha256"; - ] (); - ]; + ([ + h1 [txt "Reproducible OPAM builds"]; + p [ txt "This website offers binary MirageOS unikernels and \ + supplementary OS packages." ]; + p [ txt "Following is a list of jobs that are built daily. A \ + persistent link to the latest successful build is available \ + as /job/*jobname*/build/latest/. All builds can be \ + reproduced with "; + a ~a:[a_href "https://github.com/roburio/orb/"] [txt "orb"]; + txt ". The builds are scheduled and executed by "; + a ~a:[a_href "https://github.com/roburio/builder/"] [txt "builder"]; + txt ". The web interface is "; + a ~a:[a_href "https://git.robur.io/robur/builder-web/"] + [txt "builder-web"]; + txt ". Contact team@robur.coop if you have any questions or \ + suggestions."; + ]; + form ~a:[a_action "/hash"; a_method `Get] + [ + label [ + txt "Search artifact by SHA256"; + br (); input ~a:[ - a_input_type `Submit; - a_value "Search"; + a_input_type `Search; + a_id "sha256"; + a_name "sha256"; ] (); ]; - ] @ + input ~a:[ + a_input_type `Submit; + a_value "Search"; + ] (); + ]; + ] @ Utils.String_map.fold (fun section jobs acc -> acc @ [ h2 [ txt section ]; @@ -195,27 +229,32 @@ module Builds = struct br (); txt (Option.value ~default:"" synopsis); br () - ] @ - List.flatten - (List.map (fun (platform, latest_build, latest_artifact) -> - [ - check_icon latest_build.Builder_db.Build.result; - txt " "; - a ~a:[Fmt.kstr a_href "job/%s/%a" job_name pp_platform_query (Some platform)][txt platform]; - txt " "; - a ~a:[Fmt.kstr a_href "job/%s/build/%a/" job_name Uuidm.pp - latest_build.Builder_db.Build.uuid] - [txtf "%a" pp_ptime latest_build.Builder_db.Build.start]; - txt " "; - ] @ (match latest_artifact with - | Some main_binary -> - artifact ~basename:true job_name latest_build main_binary - | None -> - [ txtf "Build failure: %a" Builder.pp_execution_result - latest_build.Builder_db.Build.result ] - ) @ [ br () ]) - platform_builds) - )) + ] @ List.concat_map (fun (platform, latest_build, latest_artifact) -> + [ + check_icon latest_build.Builder_db.Build.result; + txt " "; + a ~a:[ + Fmt.kstr a_href "job/%s/%a" + job_name + pp_platform_query (Some platform)] + [txt platform]; + txt " "; + a ~a:[ + Fmt.kstr a_href "job/%s/build/%a/" + job_name + Uuidm.pp latest_build.Builder_db.Build.uuid] + [txtf "%a" pp_ptime latest_build.Builder_db.Build.start]; + txt " "; + ] @ (match latest_artifact with + | Some main_binary -> + artifact ~basename:true job_name latest_build main_binary + | None -> + [ txtf "Build failure: %a" Builder.pp_execution_result + latest_build.Builder_db.Build.result ] + ) @ [ br () ] + ) + platform_builds) + ) jobs) ]) section_job_map @@ -232,7 +271,9 @@ end module Job = struct let make ~failed name platform readme builds = - layout ~nav:(`Job (name, platform)) ~title:(Fmt.str "Job %s %a" name pp_platform platform) + layout + ~nav:(`Job (name, platform)) + ~title:(Fmt.str "Job %s %a" name pp_platform platform) ((h1 [txtf "Job %s %a" name pp_platform platform] :: (match readme with | None -> [] @@ -249,7 +290,10 @@ module Job = struct li ([ check_icon build.Builder_db.Build.result; txtf " %s " build.platform; - a ~a:[Fmt.kstr a_href "/job/%s/build/%a/" name Uuidm.pp build.Builder_db.Build.uuid] + a ~a:[ + Fmt.kstr a_href "/job/%s/build/%a/" + name + Uuidm.pp build.Builder_db.Build.uuid ] [ txtf "%a" pp_ptime build.Builder_db.Build.start; ]; @@ -262,9 +306,15 @@ module Job = struct build.Builder_db.Build.result ])) builds); if failed then - p [ txt "Excluding failed builds " ; a ~a:[a_href "../"] [txt "here"] ; txt "." ] + p [ + txt "Excluding failed builds " ; + a ~a:[a_href "../"] [txt "here"] ; + txt "." ] else - p [ txt "Including failed builds " ; a ~a:[a_href "failed/"] [txt "here"] ; txt "." ] + p [ + txt "Including failed builds " ; + a ~a:[a_href "failed/"] [txt "here"] ; + txt "." ] ]) end @@ -315,7 +365,9 @@ module Job_build = struct ]; ]) artifacts); - h3 [ txtf "Reproduced by %d builds" (List.length (same_input_same_output @ different_input_same_output))] ; + h3 [ + txtf "Reproduced by %d builds" + (List.length (same_input_same_output @ different_input_same_output))] ; ul ((List.map (fun { Builder_db.Build.start ; uuid ; platform ; _ } -> li [ @@ -327,8 +379,10 @@ module Job_build = struct List.map (fun { Builder_db.Build.start ; uuid = other_uuid ; platform ; _ } -> li [ txtf "on %s, different input, " platform; - a ~a:[Fmt.kstr a_href "/compare/%a/%a/" - Uuidm.pp other_uuid Uuidm.pp build.uuid] + a ~a:[ + Fmt.kstr a_href "/compare/%a/%a/" + Uuidm.pp other_uuid + Uuidm.pp build.uuid] [txtf "%a" pp_ptime start] ]) different_input_same_output) @@ -341,7 +395,10 @@ module Job_build = struct List.map (fun { Builder_db.Build.start ; uuid = other_uuid ; platform ; _ } -> li [ txtf "on %s, " platform ; - a ~a:[Fmt.kstr a_href "/compare/%a/%a/" Uuidm.pp other_uuid Uuidm.pp build.uuid] + a ~a:[ + Fmt.kstr a_href "/compare/%a/%a/" + Uuidm.pp other_uuid + Uuidm.pp build.uuid] [txtf "%a" pp_ptime start] ]) same_input_different_output) @@ -437,7 +494,8 @@ module Job_build = struct " in let style_col_container = a_style "" in - let style_col_left = a_style "width: 45em; min-width: 43em; padding-left: 2%" in + let style_col_left = + a_style "width: 45em; min-width: 43em; padding-left: 2%" in let style_col_right = a_style "width: 50%" in let body = [ div ~a:[ style_grid_container ] [ @@ -468,45 +526,45 @@ let key_value_changes xs = let packages packages = OpamPackage.Set.elements packages |> List.concat_map (fun p -> [ - txtf "%a" Opamdiff.pp_opampackage p; - br (); - ]) + txtf "%a" Opamdiff.pp_opampackage p; + br (); + ]) let package_diffs diffs = List.concat_map (fun pd -> [ - txtf "%a" Opamdiff.pp_version_diff pd; - br (); - ]) + txtf "%a" Opamdiff.pp_version_diff pd; + br (); + ]) diffs let opam_diffs diffs = List.concat_map (fun pd -> - h4 [ txtf "%a" Opamdiff.pp_opam_diff pd ] :: - (match pd.Opamdiff.build with None -> [] | Some a -> - let l, r = Opamdiff.commands_to_strings a in - [ - h5 [ txt "build instruction (without common prefix) modifications, old:" ] ; - code (List.concat_map (fun s -> [ txt s ; br () ]) l) ; - h5 [ txt "new" ] ; - code (List.concat_map (fun s -> [ txt s ; br () ]) r) - ]) @ - (match pd.Opamdiff.install with None -> [] | Some a -> - let l, r = Opamdiff.commands_to_strings a in - [ - h5 [ txt "install instruction (without common prefix) modifications, old:" ] ; - code (List.concat_map (fun s -> [ txt s ; br () ]) l) ; - h5 [ txt "new" ] ; - code (List.concat_map (fun s -> [ txt s ; br () ]) r) - ]) @ - (match pd.Opamdiff.url with None -> [] | Some a -> - let l, r = Opamdiff.opt_url_to_string a in - [ - h5 [ txt "URL" ] ; - txtf "old: %s" l; - br (); - txtf "new: %s" r - ]) @ - [ br () ]) + h4 [ txtf "%a" Opamdiff.pp_opam_diff pd ] :: + (match pd.Opamdiff.build with None -> [] | Some a -> + let l, r = Opamdiff.commands_to_strings a in + [ + h5 [ txt "build instruction (without common prefix) modifications, old:" ] ; + code (List.concat_map (fun s -> [ txt s ; br () ]) l) ; + h5 [ txt "new" ] ; + code (List.concat_map (fun s -> [ txt s ; br () ]) r) + ]) @ + (match pd.Opamdiff.install with None -> [] | Some a -> + let l, r = Opamdiff.commands_to_strings a in + [ + h5 [ txt "install instruction (without common prefix) modifications, old:" ] ; + code (List.concat_map (fun s -> [ txt s ; br () ]) l) ; + h5 [ txt "new" ] ; + code (List.concat_map (fun s -> [ txt s ; br () ]) r) + ]) @ + (match pd.Opamdiff.url with None -> [] | Some a -> + let l, r = Opamdiff.opt_url_to_string a in + [ + h5 [ txt "URL" ] ; + txtf "old: %s" l; + br (); + txtf "new: %s" r + ]) @ + [ br () ]) diffs let compare_builds job_left job_right @@ -517,68 +575,81 @@ let compare_builds job_left job_right layout ~nav:(`Comparison ((job_left, build_left), (job_right, build_right))) ~title:(Fmt.str "Comparing builds %a and %a" - Uuidm.pp build_left.uuid Uuidm.pp build_right.uuid) + Uuidm.pp build_left.uuid Uuidm.pp build_right.uuid) ([ h1 [txt "Comparing builds"]; h2 [ txt "Builds "; a ~a:[a_href - (Fmt.str "/job/%s/build/%a/" - job_left - Uuidm.pp build_left.uuid)] - [txtf "%s@%a %a" job_left pp_ptime build_left.start pp_platform (Some build_left.platform)]; + (Fmt.str "/job/%s/build/%a/" + job_left + Uuidm.pp build_left.uuid)] + [ txtf "%s@%a %a" + job_left + pp_ptime build_left.start + pp_platform (Some build_left.platform)]; txt " and "; a ~a:[a_href - (Fmt.str "/job/%s/build/%a/" - job_right - Uuidm.pp build_right.uuid)] - [txtf "%s@%a %a" job_right pp_ptime build_right.start pp_platform (Some build_right.platform)]; + (Fmt.str "/job/%s/build/%a/" + job_right + Uuidm.pp build_right.uuid)] + [ txtf "%s@%a %a" + job_right + pp_ptime build_right.start + pp_platform (Some build_right.platform)]; ]; - h3 [ a ~a:[Fmt.kstr a_href "/compare/%a/%a/" Uuidm.pp build_right.uuid Uuidm.pp build_left.uuid] - [txt "Compare in reverse direction"]] ; + h3 [ a ~a:[ + Fmt.kstr a_href "/compare/%a/%a/" + Uuidm.pp build_right.uuid + Uuidm.pp build_left.uuid ] + [txt "Compare in reverse direction"]] ; ul [ li [ a ~a:[a_href "#opam-packages-removed"] - [txtf "%d opam packages removed" (OpamPackage.Set.cardinal left)] + [txtf "%d opam packages removed" + (OpamPackage.Set.cardinal left)] ]; li [ a ~a:[a_href "#opam-packages-installed"] - [txtf "%d new opam packages installed" (OpamPackage.Set.cardinal right)] + [txtf "%d new opam packages installed" + (OpamPackage.Set.cardinal right)] ]; li [ a ~a:[a_href "#opam-packages-version-diff"] - [txtf "%d opam packages with version changes" (List.length version_diff)] + [txtf "%d opam packages with version changes" + (List.length version_diff)] ]; li [ a ~a:[a_href "#opam-packages-opam-diff"] - [txtf "%d opam packages with changes in their opam file" (List.length opam_diff)] + [txtf "%d opam packages with changes in their opam file" + (List.length opam_diff)] ]; li [ a ~a:[a_href "#opam-packages-unchanged"] [txtf "%d opam packages unchanged" (OpamPackage.Set.cardinal same)] ]; li [ - a ~a:[a_href "#env-added"] + a ~a:[a_href "#env-added"] [ txtf "%d environment variables added" (List.length added_env)] ]; li [ - a ~a:[a_href "#env-removed"] + a ~a:[a_href "#env-removed"] [ txtf "%d environment variables removed" (List.length removed_env)] ]; li [ - a ~a:[a_href "#env-changed"] + a ~a:[a_href "#env-changed"] [ txtf "%d environment variables changed" (List.length changed_env)] ]; li [ - a ~a:[a_href "#pkgs-added"] + a ~a:[a_href "#pkgs-added"] [ txtf "%d system packages added" (List.length added_pkgs)] ]; li [ - a ~a:[a_href "#pkgs-removed"] + a ~a:[a_href "#pkgs-removed"] [ txtf "%d system packages removed" (List.length removed_pkgs)] ]; li [ - a ~a:[a_href "#pkgs-changed"] + a ~a:[a_href "#pkgs-changed"] [ txtf "%d system packages changed" (List.length changed_pkgs)] ]; ]; @@ -593,23 +664,23 @@ let compare_builds job_left job_right code (package_diffs version_diff); h3 ~a:[a_id "opam-packages-opam-diff"] [txt "Opam packages with changes in their opam file"]] @ - opam_diffs opam_diff @ [ - h3 ~a:[a_id "opam-packages-unchanged"] - [txt "Unchanged opam packages"]; - code (packages same); - h3 ~a:[a_id "env-added"] [txt "Environment variables added"]; - code (key_values added_env); - h3 ~a:[a_id "env-removed"] [txt "Environment variables removed"]; - code (key_values removed_env); - h3 ~a:[a_id "env-changed"] [txt "Environment variables changed"]; - code (key_value_changes changed_env); - h3 ~a:[a_id "pkgs-added"] [txt "System packages added"]; - code (key_values added_pkgs); - h3 ~a:[a_id "pkgs-removed"] [txt "System packages removed"]; - code (key_values removed_pkgs); - h3 ~a:[a_id "pkgs-changed"] [txt "System packages changed"]; - code (key_value_changes changed_pkgs); - ]) + opam_diffs opam_diff @ [ + h3 ~a:[a_id "opam-packages-unchanged"] + [txt "Unchanged opam packages"]; + code (packages same); + h3 ~a:[a_id "env-added"] [txt "Environment variables added"]; + code (key_values added_env); + h3 ~a:[a_id "env-removed"] [txt "Environment variables removed"]; + code (key_values removed_env); + h3 ~a:[a_id "env-changed"] [txt "Environment variables changed"]; + code (key_value_changes changed_env); + h3 ~a:[a_id "pkgs-added"] [txt "System packages added"]; + code (key_values added_pkgs); + h3 ~a:[a_id "pkgs-removed"] [txt "System packages removed"]; + code (key_values removed_pkgs); + h3 ~a:[a_id "pkgs-changed"] [txt "System packages changed"]; + code (key_value_changes changed_pkgs); + ]) let failed_builds ~start ~count builds = let build (job_name, build) = @@ -622,12 +693,15 @@ let failed_builds ~start ~count builds = ] in layout ~title:"Failed builds" - ([ h1 [txt "Failed builds"]; - ul (List.map build builds); - p [ txtf "View the next %d failed builds " count; - a ~a:[Fmt.kstr a_href "/failed-builds/?count=%d&start=%d" count (start + count)] - [ txt "here"]; - txt "."; - ] + ([ + h1 [txt "Failed builds"]; + ul (List.map build builds); + p [ txtf "View the next %d failed builds " count; + a ~a:[ + Fmt.kstr a_href "/failed-builds/?count=%d&start=%d" + count (start + count) ] + [ txt "here"]; + txt "."; + ] ]) From f8b17e6b17b4103c588dde56f07a9e2f2e09b11e Mon Sep 17 00:00:00 2001 From: rand00 Date: Thu, 3 Feb 2022 12:54:02 +0100 Subject: [PATCH 05/21] Views: Removed global open of Tyxml.Html and switched to prefix - .. there are too many common names in this modules scope, and code gets easier to understand .. also I don't think global open is a good idea in general for this kind of module, so better to fix this style now than be sorry later --- lib/views.ml | 447 ++++++++++++++++++++++++++------------------------- 1 file changed, 228 insertions(+), 219 deletions(-) diff --git a/lib/views.ml b/lib/views.ml index 1e0f837..6a3d3f8 100644 --- a/lib/views.ml +++ b/lib/views.ml @@ -1,26 +1,26 @@ -open Tyxml.Html +module H = Tyxml.Html let pp_ptime ppf ptime = let (y, m, d), ((hh, mm, ss), _) = Ptime.to_date_time ptime in Fmt.pf ppf "%04d-%02d-%02d %02d:%02d:%02dZ" y m d hh mm ss -let txtf fmt = Fmt.kstr txt fmt -let a_titlef fmt = Fmt.kstr a_title fmt +let txtf fmt = Fmt.kstr H.txt fmt +let a_titlef fmt = Fmt.kstr H.a_title fmt let check_icon result = match result with | Builder.Exited 0 -> - span ~a:[ + H.span ~a:H.[ a_style "color: green; cursor: pointer;"; a_titlef "%a" Builder.pp_execution_result result; ] - [txt "☑"] + [H.txt "☑"] | _ -> - span ~a:[ + H.span ~a:H.[ a_style "color: red; cursor: pointer;"; a_titlef "%a" Builder.pp_execution_result result; ] - [txt "☒"] + [H.txt "☒"] type nav = [ | `Default @@ -80,19 +80,22 @@ h1,h2,h3{line-height:1.2} } |} -let layout ?include_static_css ?nav:(nav_=`Default) ~title:title_ body_ = +let layout ?include_static_css ?(nav=`Default) ~title body = let breadcrumb = let to_nav kvs = - nav [ ul (List.map (fun (desc, href) -> - li [a ~a:[a_href href] [desc]]) - kvs) ] + H.nav [ + H.ul ( + List.map (fun (desc, href) -> + H.li [H.a ~a:H.[a_href href] [desc]] + ) kvs + )] in - match nav_ with + match nav with | `Default -> - to_nav [txt "Home", "/"] + to_nav [H.txt "Home", "/"] | `Job (job_name, platform) -> to_nav [ - txt "Home", "/"; + H.txt "Home", "/"; txtf "Job %s" job_name, Fmt.str "/job/%s/" job_name ; ( txtf "%a" pp_platform platform, @@ -101,7 +104,7 @@ let layout ?include_static_css ?nav:(nav_=`Default) ~title:title_ body_ = ] | `Build (job_name, build) -> to_nav [ - txt "Home", "/"; + H.txt "Home", "/"; txtf "Job %s" job_name, Fmt.str "/job/%s/" job_name; ( txtf "%a" pp_platform (Some build.Builder_db.Build.platform), @@ -116,7 +119,7 @@ let layout ?include_static_css ?nav:(nav_=`Default) ~title:title_ body_ = ] | `Comparison ((job_left, build_left), (job_right, build_right)) -> to_nav [ - txt "Home", "/"; + H.txt "Home", "/"; txtf "Comparison between %s@%a and %s@%a" job_left pp_ptime build_left.Builder_db.Build.start job_right pp_ptime build_right.Builder_db.Build.start, @@ -128,32 +131,32 @@ let layout ?include_static_css ?nav:(nav_=`Default) ~title:title_ body_ = (*> Note: Last declared CSS wins - so one can override here*) let static_css = static_css :: Option.to_list include_static_css in - html - (head (title (txt title_)) - [style ~a:[a_mime_type "text/css"] static_css]) + H.html + (H.head (H.title (H.txt title)) + [H.style ~a:H.[a_mime_type "text/css"] static_css]) - (body [ + (H.body [ breadcrumb; - main body_ + H.main body ]) let toggleable ?(hidden=true) id description content = - let checked = if hidden then [] else [a_checked ()] in - div [ - label - ~a:[ + let checked = if hidden then [] else H.[a_checked ()] in + H.div [ + H.label + ~a:H.[ a_label_for id; a_class ["toggleable-descr"]; ] - [txt description]; - input - ~a:(checked @ [ + [H.txt description]; + H.input + ~a:(checked @ H.[ a_input_type `Checkbox; a_id id; a_style "display: none;"; ]) (); - div - ~a:[ + H.div + ~a:H.[ a_class ["toggleable"] ] content; @@ -172,13 +175,13 @@ let artifact Fpath.pp filepath in [ - a ~a:[a_href artifact_link] + H.a ~a:H.[a_href artifact_link] [ - if basename then txt (Fpath.basename filepath) + if basename then H.txt (Fpath.basename filepath) else txtf "%a" Fpath.pp filepath ]; - txt " "; - code [txtf "SHA256:%a" Hex.pp (Hex.of_cstruct sha256)]; + H.txt " "; + H.code [txtf "SHA256:%a" Hex.pp (Hex.of_cstruct sha256)]; txtf " (%a)" Fmt.byte_size size; ] @@ -187,34 +190,37 @@ module Builds = struct let make section_job_map = layout ~title:"Reproducible OPAM builds" ([ - h1 [txt "Reproducible OPAM builds"]; - p [ txt "This website offers binary MirageOS unikernels and \ + H.h1 [ H.txt "Reproducible OPAM builds" ]; + H.p [ H.txt "This website offers binary MirageOS unikernels and \ supplementary OS packages." ]; - p [ txt "Following is a list of jobs that are built daily. A \ + H.p [ + H.txt "Following is a list of jobs that are built daily. A \ persistent link to the latest successful build is available \ as /job/*jobname*/build/latest/. All builds can be \ reproduced with "; - a ~a:[a_href "https://github.com/roburio/orb/"] [txt "orb"]; - txt ". The builds are scheduled and executed by "; - a ~a:[a_href "https://github.com/roburio/builder/"] [txt "builder"]; - txt ". The web interface is "; - a ~a:[a_href "https://git.robur.io/robur/builder-web/"] - [txt "builder-web"]; - txt ". Contact team@robur.coop if you have any questions or \ + H.a ~a:H.[a_href "https://github.com/roburio/orb/"] + [H.txt "orb"]; + H.txt ". The builds are scheduled and executed by "; + H.a ~a:H.[a_href "https://github.com/roburio/builder/"] + [H.txt "builder"]; + H.txt ". The web interface is "; + H.a ~a:H.[a_href "https://git.robur.io/robur/builder-web/"] + [H.txt "builder-web"]; + H.txt ". Contact team@robur.coop if you have any questions or \ suggestions."; ]; - form ~a:[a_action "/hash"; a_method `Get] + H.form ~a:H.[a_action "/hash"; a_method `Get] [ - label [ - txt "Search artifact by SHA256"; - br (); - input ~a:[ + H.label [ + H.txt "Search artifact by SHA256"; + H.br (); + H.input ~a:H.[ a_input_type `Search; a_id "sha256"; a_name "sha256"; ] (); ]; - input ~a:[ + H.input ~a:H.[ a_input_type `Submit; a_value "Search"; ] (); @@ -222,36 +228,37 @@ module Builds = struct ] @ Utils.String_map.fold (fun section jobs acc -> acc @ [ - h2 [ txt section ]; - ul (List.map (fun (job_name, synopsis, platform_builds) -> - li ([ - a ~a:[a_href ("job/" ^ job_name ^ "/")] [txt job_name]; - br (); - txt (Option.value ~default:"" synopsis); - br () + H.h2 [ H.txt section ]; + H.ul (List.map (fun (job_name, synopsis, platform_builds) -> + H.li ([ + H.a ~a:H.[a_href ("job/" ^ job_name ^ "/")] + [H.txt job_name]; + H.br (); + H.txt (Option.value ~default:"" synopsis); + H.br () ] @ List.concat_map (fun (platform, latest_build, latest_artifact) -> [ check_icon latest_build.Builder_db.Build.result; - txt " "; - a ~a:[ - Fmt.kstr a_href "job/%s/%a" + H.txt " "; + H.a ~a:[ + Fmt.kstr H.a_href "job/%s/%a" job_name pp_platform_query (Some platform)] - [txt platform]; - txt " "; - a ~a:[ - Fmt.kstr a_href "job/%s/build/%a/" + [H.txt platform]; + H.txt " "; + H.a ~a:[ + Fmt.kstr H.a_href "job/%s/build/%a/" job_name Uuidm.pp latest_build.Builder_db.Build.uuid] [txtf "%a" pp_ptime latest_build.Builder_db.Build.start]; - txt " "; + H.txt " "; ] @ (match latest_artifact with | Some main_binary -> artifact ~basename:true job_name latest_build main_binary | None -> [ txtf "Build failure: %a" Builder.pp_execution_result latest_build.Builder_db.Build.result ] - ) @ [ br () ] + ) @ [ H.br () ] ) platform_builds) ) @@ -259,11 +266,11 @@ module Builds = struct ]) section_job_map [] @ - [ p [ - txt "View the latest failed builds "; - a ~a:[a_href "/failed-builds/"] - [txt "here"]; - txt "." + [ H.p [ + H.txt "View the latest failed builds "; + H.a ~a:H.[a_href "/failed-builds/"] + [H.txt "here"]; + H.txt "." ]]) end @@ -274,30 +281,30 @@ module Job = struct layout ~nav:(`Job (name, platform)) ~title:(Fmt.str "Job %s %a" name pp_platform platform) - ((h1 [txtf "Job %s %a" name pp_platform platform] :: + ((H.h1 [txtf "Job %s %a" name pp_platform platform] :: (match readme with | None -> [] | Some data -> [ - h2 ~a:[a_id "readme"] [txt "README"]; - a ~a:[a_href "#builds"] [txt "Skip to builds"]; - Unsafe.data (Utils.Omd.html_of_string data) + H.h2 ~a:H.[a_id "readme"] [H.txt "README"]; + H.a ~a:H.[a_href "#builds"] [H.txt "Skip to builds"]; + H.Unsafe.data (Utils.Omd.html_of_string data) ])) @ [ - h2 ~a:[a_id "builds"] [txt "Builds"]; - a ~a:[a_href "#readme"] [txt "Back to readme"]; - ul (List.map (fun (build, main_binary) -> - li ([ + H.h2 ~a:H.[a_id "builds"] [H.txt "Builds"]; + H.a ~a:H.[a_href "#readme"] [H.txt "Back to readme"]; + H.ul (List.map (fun (build, main_binary) -> + H.li ([ check_icon build.Builder_db.Build.result; txtf " %s " build.platform; - a ~a:[ + H.a ~a:H.[ Fmt.kstr a_href "/job/%s/build/%a/" name Uuidm.pp build.Builder_db.Build.uuid ] [ txtf "%a" pp_ptime build.Builder_db.Build.start; ]; - txt " "; + H.txt " "; ] @ match main_binary with | Some main_binary -> artifact ~basename:true name build main_binary @@ -306,15 +313,15 @@ module Job = struct build.Builder_db.Build.result ])) builds); if failed then - p [ - txt "Excluding failed builds " ; - a ~a:[a_href "../"] [txt "here"] ; - txt "." ] + H.p [ + H.txt "Excluding failed builds " ; + H.a ~a:H.[a_href "../"] [H.txt "here"] ; + H.txt "." ] else - p [ - txt "Including failed builds " ; - a ~a:[a_href "failed/"] [txt "here"] ; - txt "." ] + H.p [ + H.txt "Including failed builds " ; + H.a ~a:H.[a_href "failed/"] [H.txt "here"] ; + H.txt "." ] ]) end @@ -338,48 +345,48 @@ module Job_build = struct ~latest ~next ~previous = [ - h2 ~a:[a_id "build"] [txtf "Build %a" pp_ptime build.start]; - p [txtf "Built on platform %s" build.platform ]; - p [txtf "Build took %a." Ptime.Span.pp delta ]; - p [txtf "Execution result: %a." Builder.pp_execution_result build.result]; - h3 [txt "Build info"]; - ul [ - li [ a ~a:[Fmt.kstr a_href "/job/%s/build/%a/console" name Uuidm.pp build.uuid] - [txt "Console output"]; + H.h2 ~a:H.[a_id "build"] [txtf "Build %a" pp_ptime build.start]; + H.p [txtf "Built on platform %s" build.platform ]; + H.p [txtf "Build took %a." Ptime.Span.pp delta ]; + H.p [txtf "Execution result: %a." Builder.pp_execution_result build.result]; + H.h3 [H.txt "Build info"]; + H.ul [ + H.li [ H.a ~a:H.[Fmt.kstr a_href "/job/%s/build/%a/console" name Uuidm.pp build.uuid] + [H.txt "Console output"]; ]; - li [ a ~a:[Fmt.kstr a_href "/job/%s/build/%a/script" name Uuidm.pp build.uuid] - [txt "Build script"]; + H.li [ H.a ~a:H.[Fmt.kstr a_href "/job/%s/build/%a/script" name Uuidm.pp build.uuid] + [H.txt "Build script"]; ] ]; - h3 [txt "Build artifacts"]; - dl (List.concat_map + H.h3 [H.txt "Build artifacts"]; + H.dl (List.concat_map (fun { Builder_db.filepath; localpath=_; sha256; size } -> let (`Hex sha256_hex) = Hex.of_cstruct sha256 in [ - dt [a - ~a:[Fmt.kstr a_href "f/%a" Fpath.pp filepath] - [code [txtf "%a" Fpath.pp filepath]]]; - dd [ - code [txt "SHA256:"; txt sha256_hex]; + H.dt [H.a + ~a:H.[Fmt.kstr a_href "f/%a" Fpath.pp filepath] + [H.code [txtf "%a" Fpath.pp filepath]]]; + H.dd [ + H.code [H.txt "SHA256:"; H.txt sha256_hex]; txtf " (%a)" Fmt.byte_size size; ]; ]) artifacts); - h3 [ + H.h3 [ txtf "Reproduced by %d builds" (List.length (same_input_same_output @ different_input_same_output))] ; - ul + H.ul ((List.map (fun { Builder_db.Build.start ; uuid ; platform ; _ } -> - li [ + H.li [ txtf "on %s, same input, " platform; - a ~a:[Fmt.kstr a_href "/job/%s/build/%a/" name Uuidm.pp uuid] + H.a ~a:H.[Fmt.kstr a_href "/job/%s/build/%a/" name Uuidm.pp uuid] [txtf "%a" pp_ptime start] ]) same_input_same_output) @ List.map (fun { Builder_db.Build.start ; uuid = other_uuid ; platform ; _ } -> - li [ + H.li [ txtf "on %s, different input, " platform; - a ~a:[ + H.a ~a:H.[ Fmt.kstr a_href "/compare/%a/%a/" Uuidm.pp other_uuid Uuidm.pp build.uuid] @@ -390,12 +397,12 @@ module Job_build = struct @ (if same_input_different_output = [] then [] else - [ h3 [txt "Same input, different output (not reproducible!)"]; - ul ( + [ H.h3 [H.txt "Same input, different output (not reproducible!)"]; + H.ul ( List.map (fun { Builder_db.Build.start ; uuid = other_uuid ; platform ; _ } -> - li [ + H.li [ txtf "on %s, " platform ; - a ~a:[ + H.a ~a:H.[ Fmt.kstr a_href "/compare/%a/%a/" Uuidm.pp other_uuid Uuidm.pp build.uuid] @@ -405,18 +412,20 @@ module Job_build = struct ] ) @ [ - h3 [txt "Comparisons with other builds on the same platform"]; + H.h3 [H.txt "Comparisons with other builds on the same platform"]; let opt_build (ctx, build') = match build' with | Some b when not (Uuidm.equal build.uuid b.Builder_db.Build.uuid) -> - [ li [ txt ctx; - a ~a:[Fmt.kstr a_href "/compare/%a/%a/" - Uuidm.pp b.uuid Uuidm.pp build.uuid] + [ H.li [ H.txt ctx; + H.a ~a:[ + Fmt.kstr H.a_href "/compare/%a/%a/" + Uuidm.pp b.uuid + Uuidm.pp build.uuid ] [txtf "%a" pp_ptime b.start]] ] | _ -> [] in - ul + H.ul (List.concat_map opt_build [ ("Latest build ", latest) ; ("Later build with different output ", next) ; @@ -443,19 +452,19 @@ module Job_build = struct let make_viz_section ~name ~artifacts ~uuid = [ - (* [ h3 [txt "Analysis"] ]; *) - [ p [ + (* [ H.h3 [txt "Analysis"] ]; *) + [ H.p [ let src = Fmt.str "/job/%s/build/%a/vizdependencies" name Uuidm.pp uuid in - iframe ~a:[ + H.iframe ~a:H.[ a_src src; a_title "Opam dependencies"; a_style viz_style_deps ] [] ]]; if not @@ contains_debug_bin artifacts then [] else [ - p [ + H.p [ let src = Fmt.str "/job/%s/build/%a/viztreemap" name Uuidm.pp uuid in - iframe ~a:[ + H.iframe ~a:H.[ a_src src; a_title "Binary dissection"; a_style viz_style_treemap @@ -485,26 +494,26 @@ module Job_build = struct ~same_input_different_output ~latest ~next ~previous in - let style_grid = a_style "display: flex; " in - let style_grid_container = a_style "\ + let style_grid = H.a_style "display: flex; " in + let style_grid_container = H.a_style "\ display: flex; align-items: center; justify-content: center; min-width: 83em; " in - let style_col_container = a_style "" in + let style_col_container = H.a_style "" in let style_col_left = - a_style "width: 45em; min-width: 43em; padding-left: 2%" in - let style_col_right = a_style "width: 50%" in + H.a_style "width: 45em; min-width: 43em; padding-left: 2%" in + let style_col_right = H.a_style "width: 50%" in let body = [ - div ~a:[ style_grid_container ] [ - div ~a:[ style_col_container ] [ - h1 [txtf "Job %s" name]; - div ~a:[ style_grid ] [ - (* div ~a:[ style_col_padding ] []; *) - div ~a:[ style_col_left ] left_column; - div ~a:[ style_col_right ] right_column + H.div~a:[ style_grid_container ] [ + H.div~a:[ style_col_container ] [ + H.h1 [txtf "Job %s" name]; + H.div~a:[ style_grid ] [ + (* H.div~a:H.[ style_col_padding ] []; *) + H.div~a:[ style_col_left ] left_column; + H.div~a:[ style_col_right ] right_column ] ] ] @@ -518,53 +527,53 @@ module Job_build = struct end let key_values xs = - List.concat_map (fun (k, v) -> [ txtf "%s %s" k v ; br () ]) xs + List.concat_map (fun (k, v) -> [ txtf "%s %s" k v ; H.br () ]) xs let key_value_changes xs = - List.concat_map (fun (k, v, v') -> [ txtf "%s %s->%s" k v v' ; br () ]) xs + List.concat_map (fun (k, v, v') -> [ txtf "%s %s->%s" k v v' ; H.br () ]) xs let packages packages = OpamPackage.Set.elements packages |> List.concat_map (fun p -> [ txtf "%a" Opamdiff.pp_opampackage p; - br (); + H.br (); ]) let package_diffs diffs = List.concat_map (fun pd -> [ txtf "%a" Opamdiff.pp_version_diff pd; - br (); + H.br (); ]) diffs let opam_diffs diffs = List.concat_map (fun pd -> - h4 [ txtf "%a" Opamdiff.pp_opam_diff pd ] :: + H.h4 [ txtf "%a" Opamdiff.pp_opam_diff pd ] :: (match pd.Opamdiff.build with None -> [] | Some a -> let l, r = Opamdiff.commands_to_strings a in [ - h5 [ txt "build instruction (without common prefix) modifications, old:" ] ; - code (List.concat_map (fun s -> [ txt s ; br () ]) l) ; - h5 [ txt "new" ] ; - code (List.concat_map (fun s -> [ txt s ; br () ]) r) + H.h5 [ H.txt "build instruction (without common prefix) modifications, old:" ] ; + H.code (List.concat_map (fun s -> [ H.txt s ; H.br () ]) l) ; + H.h5 [ H.txt "new" ] ; + H.code (List.concat_map (fun s -> [ H.txt s ; H.br () ]) r) ]) @ (match pd.Opamdiff.install with None -> [] | Some a -> let l, r = Opamdiff.commands_to_strings a in [ - h5 [ txt "install instruction (without common prefix) modifications, old:" ] ; - code (List.concat_map (fun s -> [ txt s ; br () ]) l) ; - h5 [ txt "new" ] ; - code (List.concat_map (fun s -> [ txt s ; br () ]) r) + H.h5 [ H.txt "install instruction (without common prefix) modifications, old:" ] ; + H.code (List.concat_map (fun s -> [ H.txt s ; H.br () ]) l) ; + H.h5 [ H.txt "new" ] ; + H.code (List.concat_map (fun s -> [ H.txt s ; H.br () ]) r) ]) @ (match pd.Opamdiff.url with None -> [] | Some a -> let l, r = Opamdiff.opt_url_to_string a in [ - h5 [ txt "URL" ] ; + H.h5 [ H.txt "URL" ] ; txtf "old: %s" l; - br (); + H.br (); txtf "new: %s" r ]) @ - [ br () ]) + [ H.br () ]) diffs let compare_builds job_left job_right @@ -577,10 +586,10 @@ let compare_builds job_left job_right ~title:(Fmt.str "Comparing builds %a and %a" Uuidm.pp build_left.uuid Uuidm.pp build_right.uuid) ([ - h1 [txt "Comparing builds"]; - h2 [ - txt "Builds "; - a ~a:[a_href + H.h1 [H.txt "Comparing builds"]; + H.h2 [ + H.txt "Builds "; + H.a ~a:H.[a_href (Fmt.str "/job/%s/build/%a/" job_left Uuidm.pp build_left.uuid)] @@ -588,8 +597,8 @@ let compare_builds job_left job_right job_left pp_ptime build_left.start pp_platform (Some build_left.platform)]; - txt " and "; - a ~a:[a_href + H.txt " and "; + H.a ~a:H.[a_href (Fmt.str "/job/%s/build/%a/" job_right Uuidm.pp build_right.uuid)] @@ -598,110 +607,110 @@ let compare_builds job_left job_right pp_ptime build_right.start pp_platform (Some build_right.platform)]; ]; - h3 [ a ~a:[ + H.h3 [ H.a ~a:H.[ Fmt.kstr a_href "/compare/%a/%a/" Uuidm.pp build_right.uuid Uuidm.pp build_left.uuid ] - [txt "Compare in reverse direction"]] ; - ul [ - li [ - a ~a:[a_href "#opam-packages-removed"] + [H.txt "Compare in reverse direction"]] ; + H.ul [ + H.li [ + H.a ~a:H.[a_href "#opam-packages-removed"] [txtf "%d opam packages removed" (OpamPackage.Set.cardinal left)] ]; - li [ - a ~a:[a_href "#opam-packages-installed"] + H.li [ + H.a ~a:H.[a_href "#opam-packages-installed"] [txtf "%d new opam packages installed" (OpamPackage.Set.cardinal right)] ]; - li [ - a ~a:[a_href "#opam-packages-version-diff"] + H.li [ + H.a ~a:H.[a_href "#opam-packages-version-diff"] [txtf "%d opam packages with version changes" (List.length version_diff)] ]; - li [ - a ~a:[a_href "#opam-packages-opam-diff"] + H.li [ + H.a ~a:H.[a_href "#opam-packages-opam-diff"] [txtf "%d opam packages with changes in their opam file" (List.length opam_diff)] ]; - li [ - a ~a:[a_href "#opam-packages-unchanged"] + H.li [ + H.a ~a:H.[a_href "#opam-packages-unchanged"] [txtf "%d opam packages unchanged" (OpamPackage.Set.cardinal same)] ]; - li [ - a ~a:[a_href "#env-added"] + H.li [ + H.a ~a:H.[a_href "#env-added"] [ txtf "%d environment variables added" (List.length added_env)] ]; - li [ - a ~a:[a_href "#env-removed"] + H.li [ + H.a ~a:H.[a_href "#env-removed"] [ txtf "%d environment variables removed" (List.length removed_env)] ]; - li [ - a ~a:[a_href "#env-changed"] + H.li [ + H.a ~a:H.[a_href "#env-changed"] [ txtf "%d environment variables changed" (List.length changed_env)] ]; - li [ - a ~a:[a_href "#pkgs-added"] + H.li [ + H.a ~a:H.[a_href "#pkgs-added"] [ txtf "%d system packages added" (List.length added_pkgs)] ]; - li [ - a ~a:[a_href "#pkgs-removed"] + H.li [ + H.a ~a:H.[a_href "#pkgs-removed"] [ txtf "%d system packages removed" (List.length removed_pkgs)] ]; - li [ - a ~a:[a_href "#pkgs-changed"] + H.li [ + H.a ~a:H.[a_href "#pkgs-changed"] [ txtf "%d system packages changed" (List.length changed_pkgs)] ]; ]; - h3 ~a:[a_id "opam-packages-removed"] - [txt "Opam packages removed"]; - code (packages left); - h3 ~a:[a_id "opam-packages-installed"] - [txt "New opam packages installed"]; - code (packages right); - h3 ~a:[a_id "opam-packages-version-diff"] - [txt "Opam packages with version changes"]; - code (package_diffs version_diff); - h3 ~a:[a_id "opam-packages-opam-diff"] - [txt "Opam packages with changes in their opam file"]] @ + H.h3 ~a:H.[a_id "opam-packages-removed"] + [H.txt "Opam packages removed"]; + H.code (packages left); + H.h3 ~a:H.[a_id "opam-packages-installed"] + [H.txt "New opam packages installed"]; + H.code (packages right); + H.h3 ~a:H.[a_id "opam-packages-version-diff"] + [H.txt "Opam packages with version changes"]; + H.code (package_diffs version_diff); + H.h3 ~a:H.[a_id "opam-packages-opam-diff"] + [H.txt "Opam packages with changes in their opam file"]] @ opam_diffs opam_diff @ [ - h3 ~a:[a_id "opam-packages-unchanged"] - [txt "Unchanged opam packages"]; - code (packages same); - h3 ~a:[a_id "env-added"] [txt "Environment variables added"]; - code (key_values added_env); - h3 ~a:[a_id "env-removed"] [txt "Environment variables removed"]; - code (key_values removed_env); - h3 ~a:[a_id "env-changed"] [txt "Environment variables changed"]; - code (key_value_changes changed_env); - h3 ~a:[a_id "pkgs-added"] [txt "System packages added"]; - code (key_values added_pkgs); - h3 ~a:[a_id "pkgs-removed"] [txt "System packages removed"]; - code (key_values removed_pkgs); - h3 ~a:[a_id "pkgs-changed"] [txt "System packages changed"]; - code (key_value_changes changed_pkgs); + H.h3 ~a:H.[a_id "opam-packages-unchanged"] + [H.txt "Unchanged opam packages"]; + H.code (packages same); + H.h3 ~a:H.[a_id "env-added"] [H.txt "Environment variables added"]; + H.code (key_values added_env); + H.h3 ~a:H.[a_id "env-removed"] [H.txt "Environment variables removed"]; + H.code (key_values removed_env); + H.h3 ~a:H.[a_id "env-changed"] [H.txt "Environment variables changed"]; + H.code (key_value_changes changed_env); + H.h3 ~a:H.[a_id "pkgs-added"] [H.txt "System packages added"]; + H.code (key_values added_pkgs); + H.h3 ~a:H.[a_id "pkgs-removed"] [H.txt "System packages removed"]; + H.code (key_values removed_pkgs); + H.h3 ~a:H.[a_id "pkgs-changed"] [H.txt "System packages changed"]; + H.code (key_value_changes changed_pkgs); ]) let failed_builds ~start ~count builds = let build (job_name, build) = - li [ + H.li [ check_icon build.Builder_db.Build.result; txtf " %s %a " job_name pp_platform (Some build.platform); - a ~a:[Fmt.kstr a_href "/job/%s/build/%a/" job_name Uuidm.pp build.uuid] + H.a ~a:H.[Fmt.kstr a_href "/job/%s/build/%a/" job_name Uuidm.pp build.uuid] [txtf "%a" pp_ptime build.start]; txtf " %a" Builder.pp_execution_result build.result; ] in layout ~title:"Failed builds" ([ - h1 [txt "Failed builds"]; - ul (List.map build builds); - p [ txtf "View the next %d failed builds " count; - a ~a:[ + H.h1 [H.txt "Failed builds"]; + H.ul (List.map build builds); + H.p [ txtf "View the next %d failed builds " count; + H.a ~a:H.[ Fmt.kstr a_href "/failed-builds/?count=%d&start=%d" count (start + count) ] - [ txt "here"]; - txt "."; + [ H.txt "here"]; + H.txt "."; ] ]) From 3680336b221c7446387aaa684676c90daf2fcc90 Mon Sep 17 00:00:00 2001 From: rand00 Date: Thu, 3 Feb 2022 12:57:21 +0100 Subject: [PATCH 06/21] Views: Removed outcommented + fixed some 80-col problems --- lib/views.ml | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/lib/views.ml b/lib/views.ml index 6a3d3f8..deae14b 100644 --- a/lib/views.ml +++ b/lib/views.ml @@ -337,7 +337,7 @@ module Job_build = struct let make_build_info ~name ~delta - ~(build:Builder_db.Build.t) (* ({ Builder_db.Build.uuid; start; finish; result; platform; _ } as build) *) + ~(build:Builder_db.Build.t) ~artifacts ~same_input_same_output ~different_input_same_output @@ -351,11 +351,15 @@ module Job_build = struct H.p [txtf "Execution result: %a." Builder.pp_execution_result build.result]; H.h3 [H.txt "Build info"]; H.ul [ - H.li [ H.a ~a:H.[Fmt.kstr a_href "/job/%s/build/%a/console" name Uuidm.pp build.uuid] - [H.txt "Console output"]; + H.li [ + H.a ~a:H.[ + Fmt.kstr a_href "/job/%s/build/%a/console" name Uuidm.pp build.uuid + ] [H.txt "Console output"]; ]; - H.li [ H.a ~a:H.[Fmt.kstr a_href "/job/%s/build/%a/script" name Uuidm.pp build.uuid] - [H.txt "Build script"]; + H.li [ + H.a ~a:H.[ + Fmt.kstr a_href "/job/%s/build/%a/script" name Uuidm.pp build.uuid + ] [H.txt "Build script"]; ] ]; H.h3 [H.txt "Build artifacts"]; From db3f87934b4e81eb44d1ab998add4af10f374a7c Mon Sep 17 00:00:00 2001 From: rand00 Date: Thu, 3 Feb 2022 13:27:22 +0100 Subject: [PATCH 07/21] Views++: Made long parameter-lists into named parameters --- lib/builder_web.ml | 17 +++++++++++++---- lib/views.ml | 44 +++++++++++++++++++++++++++----------------- 2 files changed, 40 insertions(+), 21 deletions(-) diff --git a/lib/builder_web.ml b/lib/builder_web.ml index e9f675e..7a5831f 100644 --- a/lib/builder_web.ml +++ b/lib/builder_web.ml @@ -138,7 +138,9 @@ let add_routes datadir = |> if_error "Error getting job" ~log:(fun e -> Log.warn (fun m -> m "Error getting job: %a" pp_error e)) >>= fun (readme, builds) -> - Views.Job.make ~failed:false job_name platform readme builds |> string_of_html |> Dream.html |> Lwt_result.ok + builds + |> Views.Job.make ~failed:false ~job_name ~platform ~readme + |> string_of_html |> Dream.html |> Lwt_result.ok in let job_with_failed req = @@ -150,7 +152,9 @@ let add_routes datadir = |> if_error "Error getting job" ~log:(fun e -> Log.warn (fun m -> m "Error getting job: %a" pp_error e)) >>= fun (readme, builds) -> - Views.Job.make ~failed:true job_name platform readme builds |> string_of_html |> Dream.html |> Lwt_result.ok + builds + |> Views.Job.make ~failed:true ~job_name ~platform ~readme + |> string_of_html |> Dream.html |> Lwt_result.ok in let redirect_latest req = @@ -446,8 +450,13 @@ let add_routes datadir = in let switch_left = OpamFile.SwitchExport.read_from_string switch_left and switch_right = OpamFile.SwitchExport.read_from_string switch_right in - Opamdiff.compare switch_left switch_right - |> Views.compare_builds job_left job_right build_left build_right env_diff pkg_diff + let opam_diff = Opamdiff.compare switch_left switch_right in + Views.compare_builds + ~job_left ~job_right + ~build_left ~build_right + ~env_diff + ~pkg_diff + ~opam_diff |> string_of_html |> Dream.html |> Lwt_result.ok in diff --git a/lib/views.ml b/lib/views.ml index deae14b..ad508a2 100644 --- a/lib/views.ml +++ b/lib/views.ml @@ -140,7 +140,7 @@ let layout ?include_static_css ?(nav=`Default) ~title body = H.main body ]) -let toggleable ?(hidden=true) id description content = +let toggleable ?(hidden=true) ~id ~description content = let checked = if hidden then [] else H.[a_checked ()] in H.div [ H.label @@ -163,10 +163,10 @@ let toggleable ?(hidden=true) id description content = ] let artifact - ?(basename=false) - job_name - build - { Builder_db.filepath; localpath = _; sha256; size } + ~basename + ~job_name + ~build + ~file:{ Builder_db.filepath; localpath = _; sha256; size } = let artifact_link = Fmt.str "/job/%s/build/%a/f/%a" @@ -254,7 +254,11 @@ module Builds = struct H.txt " "; ] @ (match latest_artifact with | Some main_binary -> - artifact ~basename:true job_name latest_build main_binary + artifact + ~basename:true + ~job_name + ~build:latest_build + ~file:main_binary | None -> [ txtf "Build failure: %a" Builder.pp_execution_result latest_build.Builder_db.Build.result ] @@ -277,11 +281,11 @@ end module Job = struct - let make ~failed name platform readme builds = + let make ~failed ~job_name ~platform ~readme builds = layout - ~nav:(`Job (name, platform)) - ~title:(Fmt.str "Job %s %a" name pp_platform platform) - ((H.h1 [txtf "Job %s %a" name pp_platform platform] :: + ~nav:(`Job (job_name, platform)) + ~title:(Fmt.str "Job %s %a" job_name pp_platform platform) + ((H.h1 [txtf "Job %s %a" job_name pp_platform platform] :: (match readme with | None -> [] | Some data -> @@ -299,7 +303,7 @@ module Job = struct txtf " %s " build.platform; H.a ~a:H.[ Fmt.kstr a_href "/job/%s/build/%a/" - name + job_name Uuidm.pp build.Builder_db.Build.uuid ] [ txtf "%a" pp_ptime build.Builder_db.Build.start; @@ -307,7 +311,11 @@ module Job = struct H.txt " "; ] @ match main_binary with | Some main_binary -> - artifact ~basename:true name build main_binary + artifact + ~basename:true + ~job_name + ~build + ~file:main_binary | None -> [ txtf "Build failure: %a" Builder.pp_execution_result build.Builder_db.Build.result ])) @@ -580,11 +588,13 @@ let opam_diffs diffs = [ H.br () ]) diffs -let compare_builds job_left job_right - (build_left : Builder_db.Build.t) (build_right : Builder_db.Build.t) - (added_env, removed_env, changed_env) - (added_pkgs, removed_pkgs, changed_pkgs) - (same, opam_diff, version_diff, left, right) = +let compare_builds + ~job_left ~job_right + ~(build_left : Builder_db.Build.t) ~(build_right : Builder_db.Build.t) + ~env_diff:(added_env, removed_env, changed_env) + ~pkg_diff:(added_pkgs, removed_pkgs, changed_pkgs) + ~opam_diff:(same, opam_diff, version_diff, left, right) + = layout ~nav:(`Comparison ((job_left, build_left), (job_right, build_right))) ~title:(Fmt.str "Comparing builds %a and %a" From b631b05de2c787595ebb250369a44979d672a8e7 Mon Sep 17 00:00:00 2001 From: rand00 Date: Thu, 3 Feb 2022 13:28:16 +0100 Subject: [PATCH 08/21] Views: Syntax --- lib/views.ml | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lib/views.ml b/lib/views.ml index ad508a2..463ff82 100644 --- a/lib/views.ml +++ b/lib/views.ml @@ -589,8 +589,10 @@ let opam_diffs diffs = diffs let compare_builds - ~job_left ~job_right - ~(build_left : Builder_db.Build.t) ~(build_right : Builder_db.Build.t) + ~job_left + ~job_right + ~(build_left : Builder_db.Build.t) + ~(build_right : Builder_db.Build.t) ~env_diff:(added_env, removed_env, changed_env) ~pkg_diff:(added_pkgs, removed_pkgs, changed_pkgs) ~opam_diff:(same, opam_diff, version_diff, left, right) From 87442c4a094dd5875eebbc9a74687253ce50f754 Mon Sep 17 00:00:00 2001 From: rand00 Date: Thu, 3 Feb 2022 13:50:32 +0100 Subject: [PATCH 09/21] Views: Builds: Separated html-generation out into named functions for ease of reading --- lib/views.ml | 168 +++++++++++++++++++++++++++------------------------ 1 file changed, 89 insertions(+), 79 deletions(-) diff --git a/lib/views.ml b/lib/views.ml index 463ff82..ae22a4b 100644 --- a/lib/views.ml +++ b/lib/views.ml @@ -187,89 +187,99 @@ let artifact module Builds = struct - let make section_job_map = - layout ~title:"Reproducible OPAM builds" - ([ - H.h1 [ H.txt "Reproducible OPAM builds" ]; - H.p [ H.txt "This website offers binary MirageOS unikernels and \ - supplementary OS packages." ]; - H.p [ - H.txt "Following is a list of jobs that are built daily. A \ - persistent link to the latest successful build is available \ - as /job/*jobname*/build/latest/. All builds can be \ - reproduced with "; - H.a ~a:H.[a_href "https://github.com/roburio/orb/"] - [H.txt "orb"]; - H.txt ". The builds are scheduled and executed by "; - H.a ~a:H.[a_href "https://github.com/roburio/builder/"] - [H.txt "builder"]; - H.txt ". The web interface is "; - H.a ~a:H.[a_href "https://git.robur.io/robur/builder-web/"] - [H.txt "builder-web"]; - H.txt ". Contact team@robur.coop if you have any questions or \ + let make_header = + [ + H.h1 [ H.txt "Reproducible OPAM builds" ]; + H.p [ H.txt "This website offers binary MirageOS unikernels and \ + supplementary OS packages." ]; + H.p [ + H.txt "Following is a list of jobs that are built daily. A \ + persistent link to the latest successful build is available \ + as /job/*jobname*/build/latest/. All builds can be \ + reproduced with "; + H.a ~a:H.[a_href "https://github.com/roburio/orb/"] + [H.txt "orb"]; + H.txt ". The builds are scheduled and executed by "; + H.a ~a:H.[a_href "https://github.com/roburio/builder/"] + [H.txt "builder"]; + H.txt ". The web interface is "; + H.a ~a:H.[a_href "https://git.robur.io/robur/builder-web/"] + [H.txt "builder-web"]; + H.txt ". Contact team@robur.coop if you have any questions or \ suggestions."; - ]; - H.form ~a:H.[a_action "/hash"; a_method `Get] - [ - H.label [ - H.txt "Search artifact by SHA256"; - H.br (); - H.input ~a:H.[ - a_input_type `Search; - a_id "sha256"; - a_name "sha256"; - ] (); - ]; + ]; + H.form ~a:H.[a_action "/hash"; a_method `Get] + [ + H.label [ + H.txt "Search artifact by SHA256"; + H.br (); H.input ~a:H.[ - a_input_type `Submit; - a_value "Search"; + a_input_type `Search; + a_id "sha256"; + a_name "sha256"; ] (); ]; - ] @ - Utils.String_map.fold (fun section jobs acc -> - acc @ [ - H.h2 [ H.txt section ]; - H.ul (List.map (fun (job_name, synopsis, platform_builds) -> - H.li ([ - H.a ~a:H.[a_href ("job/" ^ job_name ^ "/")] - [H.txt job_name]; - H.br (); - H.txt (Option.value ~default:"" synopsis); - H.br () - ] @ List.concat_map (fun (platform, latest_build, latest_artifact) -> - [ - check_icon latest_build.Builder_db.Build.result; - H.txt " "; - H.a ~a:[ - Fmt.kstr H.a_href "job/%s/%a" - job_name - pp_platform_query (Some platform)] - [H.txt platform]; - H.txt " "; - H.a ~a:[ - Fmt.kstr H.a_href "job/%s/build/%a/" - job_name - Uuidm.pp latest_build.Builder_db.Build.uuid] - [txtf "%a" pp_ptime latest_build.Builder_db.Build.start]; - H.txt " "; - ] @ (match latest_artifact with - | Some main_binary -> - artifact - ~basename:true - ~job_name - ~build:latest_build - ~file:main_binary - | None -> - [ txtf "Build failure: %a" Builder.pp_execution_result - latest_build.Builder_db.Build.result ] - ) @ [ H.br () ] - ) - platform_builds) - ) - jobs) - ]) - section_job_map - [] @ + H.input ~a:H.[ + a_input_type `Submit; + a_value "Search"; + ] (); + ]; + ] + + let make_platform_builds ~job_name (platform, latest_build, latest_artifact) = + [ + check_icon latest_build.Builder_db.Build.result; + H.txt " "; + H.a ~a:[ + Fmt.kstr H.a_href "job/%s/%a" + job_name + pp_platform_query (Some platform)] + [H.txt platform]; + H.txt " "; + H.a ~a:[ + Fmt.kstr H.a_href "job/%s/build/%a/" + job_name + Uuidm.pp latest_build.Builder_db.Build.uuid] + [txtf "%a" pp_ptime latest_build.Builder_db.Build.start]; + H.txt " "; + ] @ (match latest_artifact with + | Some main_binary -> + artifact + ~basename:true + ~job_name + ~build:latest_build + ~file:main_binary + | None -> + [ txtf "Build failure: %a" Builder.pp_execution_result + latest_build.Builder_db.Build.result ] + ) @ [ H.br () ] + + let make_jobs jobs = + jobs |> List.map (fun (job_name, synopsis, platform_builds) -> + H.li ([ + H.a ~a:H.[a_href ("job/" ^ job_name ^ "/")] + [H.txt job_name]; + H.br (); + H.txt (Option.value ~default:"" synopsis); + H.br () + ] + @ List.concat_map (make_platform_builds ~job_name) platform_builds) + ) + + let make_body section_job_map = + let aux section jobs acc = + acc @ [ + H.h2 [ H.txt section ]; + H.ul (make_jobs jobs) + ] + in + Utils.String_map.fold aux section_job_map [] + + let make section_job_map = + layout ~title:"Reproducible OPAM builds" + (make_header + @ make_body section_job_map + @ [ H.p [ H.txt "View the latest failed builds "; H.a ~a:H.[a_href "/failed-builds/"] From 126fe38465b320cd1e2ca119c986835dab84ad45 Mon Sep 17 00:00:00 2001 From: rand00 Date: Thu, 3 Feb 2022 14:00:24 +0100 Subject: [PATCH 10/21] Views: Configured .ocp-indent.conf to sensible defaults, and indented everything with this. Settings are: normal base = 2 type = 2 in = 0 with = 0 match_clause = 2 ppx_stritem_ext = 2 max_indent = 2 strict_with = never strict_else = always strict_comments = false align_ops = true align_params = auto --- lib/views.ml | 217 +++++++++++++++++++++++++-------------------------- 1 file changed, 108 insertions(+), 109 deletions(-) diff --git a/lib/views.ml b/lib/views.ml index ae22a4b..0f902fc 100644 --- a/lib/views.ml +++ b/lib/views.ml @@ -133,12 +133,12 @@ let layout ?include_static_css ?(nav=`Default) ~title body = in H.html (H.head (H.title (H.txt title)) - [H.style ~a:H.[a_mime_type "text/css"] static_css]) + [H.style ~a:H.[a_mime_type "text/css"] static_css]) (H.body [ - breadcrumb; - H.main body - ]) + breadcrumb; + H.main body + ]) let toggleable ?(hidden=true) ~id ~description content = let checked = if hidden then [] else H.[a_checked ()] in @@ -297,13 +297,13 @@ module Job = struct ~title:(Fmt.str "Job %s %a" job_name pp_platform platform) ((H.h1 [txtf "Job %s %a" job_name pp_platform platform] :: (match readme with - | None -> [] - | Some data -> - [ - H.h2 ~a:H.[a_id "readme"] [H.txt "README"]; - H.a ~a:H.[a_href "#builds"] [H.txt "Skip to builds"]; - H.Unsafe.data (Utils.Omd.html_of_string data) - ])) @ + | None -> [] + | Some data -> + [ + H.h2 ~a:H.[a_id "readme"] [H.txt "README"]; + H.a ~a:H.[a_href "#builds"] [H.txt "Skip to builds"]; + H.Unsafe.data (Utils.Omd.html_of_string data) + ])) @ [ H.h2 ~a:H.[a_id "builds"] [H.txt "Builds"]; H.a ~a:H.[a_href "#readme"] [H.txt "Back to readme"]; @@ -381,30 +381,29 @@ module Job_build = struct ] ]; H.h3 [H.txt "Build artifacts"]; - H.dl (List.concat_map - (fun { Builder_db.filepath; localpath=_; sha256; size } -> - let (`Hex sha256_hex) = Hex.of_cstruct sha256 in - [ - H.dt [H.a - ~a:H.[Fmt.kstr a_href "f/%a" Fpath.pp filepath] - [H.code [txtf "%a" Fpath.pp filepath]]]; - H.dd [ - H.code [H.txt "SHA256:"; H.txt sha256_hex]; - txtf " (%a)" Fmt.byte_size size; - ]; - ]) - artifacts); + H.dl (List.concat_map (fun { Builder_db.filepath; localpath=_; sha256; size } -> + let (`Hex sha256_hex) = Hex.of_cstruct sha256 in + [ + H.dt [H.a + ~a:H.[Fmt.kstr a_href "f/%a" Fpath.pp filepath] + [H.code [txtf "%a" Fpath.pp filepath]]]; + H.dd [ + H.code [H.txt "SHA256:"; H.txt sha256_hex]; + txtf " (%a)" Fmt.byte_size size; + ]; + ]) + artifacts); H.h3 [ txtf "Reproduced by %d builds" (List.length (same_input_same_output @ different_input_same_output))] ; H.ul ((List.map (fun { Builder_db.Build.start ; uuid ; platform ; _ } -> - H.li [ - txtf "on %s, same input, " platform; - H.a ~a:H.[Fmt.kstr a_href "/job/%s/build/%a/" name Uuidm.pp uuid] - [txtf "%a" pp_ptime start] - ]) - same_input_same_output) @ + H.li [ + txtf "on %s, same input, " platform; + H.a ~a:H.[Fmt.kstr a_href "/job/%s/build/%a/" name Uuidm.pp uuid] + [txtf "%a" pp_ptime start] + ]) + same_input_same_output) @ List.map (fun { Builder_db.Build.start ; uuid = other_uuid ; platform ; _ } -> H.li [ txtf "on %s, different input, " platform; @@ -417,41 +416,41 @@ module Job_build = struct different_input_same_output) ] @ (if same_input_different_output = [] then - [] - else - [ H.h3 [H.txt "Same input, different output (not reproducible!)"]; - H.ul ( - List.map (fun { Builder_db.Build.start ; uuid = other_uuid ; platform ; _ } -> - H.li [ - txtf "on %s, " platform ; - H.a ~a:H.[ - Fmt.kstr a_href "/compare/%a/%a/" - Uuidm.pp other_uuid - Uuidm.pp build.uuid] - [txtf "%a" pp_ptime start] - ]) - same_input_different_output) - ] - ) + [] + else + [ H.h3 [H.txt "Same input, different output (not reproducible!)"]; + H.ul ( + List.map (fun { Builder_db.Build.start ; uuid = other_uuid ; platform ; _ } -> + H.li [ + txtf "on %s, " platform ; + H.a ~a:H.[ + Fmt.kstr a_href "/compare/%a/%a/" + Uuidm.pp other_uuid + Uuidm.pp build.uuid] + [txtf "%a" pp_ptime start] + ]) + same_input_different_output) + ] + ) @ [ H.h3 [H.txt "Comparisons with other builds on the same platform"]; let opt_build (ctx, build') = match build' with | Some b when not (Uuidm.equal build.uuid b.Builder_db.Build.uuid) -> [ H.li [ H.txt ctx; - H.a ~a:[ - Fmt.kstr H.a_href "/compare/%a/%a/" - Uuidm.pp b.uuid - Uuidm.pp build.uuid ] - [txtf "%a" pp_ptime b.start]] + H.a ~a:[ + Fmt.kstr H.a_href "/compare/%a/%a/" + Uuidm.pp b.uuid + Uuidm.pp build.uuid ] + [txtf "%a" pp_ptime b.start]] ] | _ -> [] in H.ul (List.concat_map opt_build - [ ("Latest build ", latest) ; - ("Later build with different output ", next) ; - ("Earlier build with different output ", previous) ]) + [ ("Latest build ", latest) ; + ("Later build with different output ", next) ; + ("Earlier build with different output ", previous) ]) ] let viz_style_deps = " @@ -572,29 +571,29 @@ let opam_diffs diffs = List.concat_map (fun pd -> H.h4 [ txtf "%a" Opamdiff.pp_opam_diff pd ] :: (match pd.Opamdiff.build with None -> [] | Some a -> - let l, r = Opamdiff.commands_to_strings a in - [ - H.h5 [ H.txt "build instruction (without common prefix) modifications, old:" ] ; - H.code (List.concat_map (fun s -> [ H.txt s ; H.br () ]) l) ; - H.h5 [ H.txt "new" ] ; - H.code (List.concat_map (fun s -> [ H.txt s ; H.br () ]) r) - ]) @ + let l, r = Opamdiff.commands_to_strings a in + [ + H.h5 [ H.txt "build instruction (without common prefix) modifications, old:" ] ; + H.code (List.concat_map (fun s -> [ H.txt s ; H.br () ]) l) ; + H.h5 [ H.txt "new" ] ; + H.code (List.concat_map (fun s -> [ H.txt s ; H.br () ]) r) + ]) @ (match pd.Opamdiff.install with None -> [] | Some a -> - let l, r = Opamdiff.commands_to_strings a in - [ - H.h5 [ H.txt "install instruction (without common prefix) modifications, old:" ] ; - H.code (List.concat_map (fun s -> [ H.txt s ; H.br () ]) l) ; - H.h5 [ H.txt "new" ] ; - H.code (List.concat_map (fun s -> [ H.txt s ; H.br () ]) r) - ]) @ + let l, r = Opamdiff.commands_to_strings a in + [ + H.h5 [ H.txt "install instruction (without common prefix) modifications, old:" ] ; + H.code (List.concat_map (fun s -> [ H.txt s ; H.br () ]) l) ; + H.h5 [ H.txt "new" ] ; + H.code (List.concat_map (fun s -> [ H.txt s ; H.br () ]) r) + ]) @ (match pd.Opamdiff.url with None -> [] | Some a -> - let l, r = Opamdiff.opt_url_to_string a in - [ - H.h5 [ H.txt "URL" ] ; - txtf "old: %s" l; - H.br (); - txtf "new: %s" r - ]) @ + let l, r = Opamdiff.opt_url_to_string a in + [ + H.h5 [ H.txt "URL" ] ; + txtf "old: %s" l; + H.br (); + txtf "new: %s" r + ]) @ [ H.br () ]) diffs @@ -610,24 +609,24 @@ let compare_builds layout ~nav:(`Comparison ((job_left, build_left), (job_right, build_right))) ~title:(Fmt.str "Comparing builds %a and %a" - Uuidm.pp build_left.uuid Uuidm.pp build_right.uuid) + Uuidm.pp build_left.uuid Uuidm.pp build_right.uuid) ([ H.h1 [H.txt "Comparing builds"]; H.h2 [ H.txt "Builds "; H.a ~a:H.[a_href - (Fmt.str "/job/%s/build/%a/" - job_left - Uuidm.pp build_left.uuid)] + (Fmt.str "/job/%s/build/%a/" + job_left + Uuidm.pp build_left.uuid)] [ txtf "%s@%a %a" job_left pp_ptime build_left.start pp_platform (Some build_left.platform)]; H.txt " and "; H.a ~a:H.[a_href - (Fmt.str "/job/%s/build/%a/" - job_right - Uuidm.pp build_right.uuid)] + (Fmt.str "/job/%s/build/%a/" + job_right + Uuidm.pp build_right.uuid)] [ txtf "%s@%a %a" job_right pp_ptime build_right.start @@ -642,22 +641,22 @@ let compare_builds H.li [ H.a ~a:H.[a_href "#opam-packages-removed"] [txtf "%d opam packages removed" - (OpamPackage.Set.cardinal left)] + (OpamPackage.Set.cardinal left)] ]; H.li [ H.a ~a:H.[a_href "#opam-packages-installed"] [txtf "%d new opam packages installed" - (OpamPackage.Set.cardinal right)] + (OpamPackage.Set.cardinal right)] ]; H.li [ H.a ~a:H.[a_href "#opam-packages-version-diff"] [txtf "%d opam packages with version changes" - (List.length version_diff)] + (List.length version_diff)] ]; H.li [ H.a ~a:H.[a_href "#opam-packages-opam-diff"] [txtf "%d opam packages with changes in their opam file" - (List.length opam_diff)] + (List.length opam_diff)] ]; H.li [ H.a ~a:H.[a_href "#opam-packages-unchanged"] @@ -699,23 +698,23 @@ let compare_builds H.code (package_diffs version_diff); H.h3 ~a:H.[a_id "opam-packages-opam-diff"] [H.txt "Opam packages with changes in their opam file"]] @ - opam_diffs opam_diff @ [ - H.h3 ~a:H.[a_id "opam-packages-unchanged"] - [H.txt "Unchanged opam packages"]; - H.code (packages same); - H.h3 ~a:H.[a_id "env-added"] [H.txt "Environment variables added"]; - H.code (key_values added_env); - H.h3 ~a:H.[a_id "env-removed"] [H.txt "Environment variables removed"]; - H.code (key_values removed_env); - H.h3 ~a:H.[a_id "env-changed"] [H.txt "Environment variables changed"]; - H.code (key_value_changes changed_env); - H.h3 ~a:H.[a_id "pkgs-added"] [H.txt "System packages added"]; - H.code (key_values added_pkgs); - H.h3 ~a:H.[a_id "pkgs-removed"] [H.txt "System packages removed"]; - H.code (key_values removed_pkgs); - H.h3 ~a:H.[a_id "pkgs-changed"] [H.txt "System packages changed"]; - H.code (key_value_changes changed_pkgs); - ]) + opam_diffs opam_diff @ [ + H.h3 ~a:H.[a_id "opam-packages-unchanged"] + [H.txt "Unchanged opam packages"]; + H.code (packages same); + H.h3 ~a:H.[a_id "env-added"] [H.txt "Environment variables added"]; + H.code (key_values added_env); + H.h3 ~a:H.[a_id "env-removed"] [H.txt "Environment variables removed"]; + H.code (key_values removed_env); + H.h3 ~a:H.[a_id "env-changed"] [H.txt "Environment variables changed"]; + H.code (key_value_changes changed_env); + H.h3 ~a:H.[a_id "pkgs-added"] [H.txt "System packages added"]; + H.code (key_values added_pkgs); + H.h3 ~a:H.[a_id "pkgs-removed"] [H.txt "System packages removed"]; + H.code (key_values removed_pkgs); + H.h3 ~a:H.[a_id "pkgs-changed"] [H.txt "System packages changed"]; + H.code (key_value_changes changed_pkgs); + ]) let failed_builds ~start ~count builds = let build (job_name, build) = @@ -732,11 +731,11 @@ let failed_builds ~start ~count builds = H.h1 [H.txt "Failed builds"]; H.ul (List.map build builds); H.p [ txtf "View the next %d failed builds " count; - H.a ~a:H.[ - Fmt.kstr a_href "/failed-builds/?count=%d&start=%d" - count (start + count) ] - [ H.txt "here"]; - H.txt "."; - ] + H.a ~a:H.[ + Fmt.kstr a_href "/failed-builds/?count=%d&start=%d" + count (start + count) ] + [ H.txt "here"]; + H.txt "."; + ] ]) From 82bcdf9f3b82f3cb2ce4cb0850ce185b0d71f2fc Mon Sep 17 00:00:00 2001 From: rand00 Date: Thu, 3 Feb 2022 14:06:11 +0100 Subject: [PATCH 11/21] Views: Removed some opened records in parameters - .. prefix with record-name is more safe and less cumbersome --- lib/views.ml | 34 +++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/lib/views.ml b/lib/views.ml index 0f902fc..a0a144a 100644 --- a/lib/views.ml +++ b/lib/views.ml @@ -381,15 +381,15 @@ module Job_build = struct ] ]; H.h3 [H.txt "Build artifacts"]; - H.dl (List.concat_map (fun { Builder_db.filepath; localpath=_; sha256; size } -> - let (`Hex sha256_hex) = Hex.of_cstruct sha256 in + H.dl (List.concat_map (fun (file:Builder_db.file) -> + let (`Hex sha256_hex) = Hex.of_cstruct file.sha256 in [ H.dt [H.a - ~a:H.[Fmt.kstr a_href "f/%a" Fpath.pp filepath] - [H.code [txtf "%a" Fpath.pp filepath]]]; + ~a:H.[Fmt.kstr a_href "f/%a" Fpath.pp file.filepath] + [H.code [txtf "%a" Fpath.pp file.filepath]]]; H.dd [ H.code [H.txt "SHA256:"; H.txt sha256_hex]; - txtf " (%a)" Fmt.byte_size size; + txtf " (%a)" Fmt.byte_size file.size; ]; ]) artifacts); @@ -397,21 +397,21 @@ module Job_build = struct txtf "Reproduced by %d builds" (List.length (same_input_same_output @ different_input_same_output))] ; H.ul - ((List.map (fun { Builder_db.Build.start ; uuid ; platform ; _ } -> + ((List.map (fun (build:Builder_db.Build.t) -> H.li [ - txtf "on %s, same input, " platform; - H.a ~a:H.[Fmt.kstr a_href "/job/%s/build/%a/" name Uuidm.pp uuid] - [txtf "%a" pp_ptime start] + txtf "on %s, same input, " build.platform; + H.a ~a:H.[Fmt.kstr a_href "/job/%s/build/%a/" name Uuidm.pp build.uuid] + [txtf "%a" pp_ptime build.start] ]) same_input_same_output) @ - List.map (fun { Builder_db.Build.start ; uuid = other_uuid ; platform ; _ } -> + List.map (fun (build':Builder_db.Build.t) -> H.li [ - txtf "on %s, different input, " platform; + txtf "on %s, different input, " build'.platform; H.a ~a:H.[ Fmt.kstr a_href "/compare/%a/%a/" - Uuidm.pp other_uuid + Uuidm.pp build'.uuid Uuidm.pp build.uuid] - [txtf "%a" pp_ptime start] + [txtf "%a" pp_ptime build'.start] ]) different_input_same_output) ] @@ -420,14 +420,14 @@ module Job_build = struct else [ H.h3 [H.txt "Same input, different output (not reproducible!)"]; H.ul ( - List.map (fun { Builder_db.Build.start ; uuid = other_uuid ; platform ; _ } -> + List.map (fun (build':Builder_db.Build.t) -> H.li [ - txtf "on %s, " platform ; + txtf "on %s, " build'.platform ; H.a ~a:H.[ Fmt.kstr a_href "/compare/%a/%a/" - Uuidm.pp other_uuid + Uuidm.pp build'.uuid Uuidm.pp build.uuid] - [txtf "%a" pp_ptime start] + [txtf "%a" pp_ptime build'.start] ]) same_input_different_output) ] From 13f2f912952a9994c1bc5434fd5e777aef2c6aeb Mon Sep 17 00:00:00 2001 From: rand00 Date: Thu, 3 Feb 2022 14:13:35 +0100 Subject: [PATCH 12/21] Added an .ocp-indent file, so we have common indentation settings --- .ocp-indent | 130 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 130 insertions(+) create mode 100644 .ocp-indent diff --git a/.ocp-indent b/.ocp-indent new file mode 100644 index 0000000..5953521 --- /dev/null +++ b/.ocp-indent @@ -0,0 +1,130 @@ +# -*- conf -*- +# This is an example configuration file for ocp-indent +# +# Copy to the root of your project with name ".ocp-indent", customise, and +# transparently get consistent indentation on all your ocaml source files. + +# Starting the configuration file with a preset ensures you won't fallback to +# definitions from "~/.ocp/ocp-indent.conf". +# These are `normal`, `apprentice` and `JaneStreet` and set different defaults. +normal + +# +# INDENTATION VALUES +# + +# Number of spaces used in all base cases, for example: +# let foo = +# ^^bar +base = 2 + +# Indent for type definitions: +# type t = +# ^^int +type = 2 + +# Indent after `let in` (unless followed by another `let`): +# let foo = () in +# ^^bar +in = 0 + +# Indent after `match/try with` or `function`: +# match foo with +# ^^| _ -> bar +with = 0 + +# Indent for clauses inside a pattern-match (after the arrow): +# match foo with +# | _ -> +# ^^^^bar +# the default is 2, which aligns the pattern and the expression +match_clause = 2 + +# Indentation for items inside extension nodes: +# [%% id.id +# ^^^^contents ] +# [@@id +# ^^^^foo +# ] +ppx_stritem_ext = 2 + +# When nesting expressions on the same line, their indentation are in +# some cases stacked, so that it remains correct if you close them one +# at a line. This may lead to large indents in complex code though, so +# this parameter can be used to set a maximum value. Note that it only +# affects indentation after function arrows and opening parens at end +# of line. +# +# for example (left: `none`; right: `4`) +# let f = g (h (i (fun x -> # let f = g (h (i (fun x -> +# x) # x) +# ) # ) +# ) # ) +max_indent = 2 + + +# +# INDENTATION TOGGLES +# + +# Wether the `with` parameter should be applied even when in a sub-block. +# Can be `always`, `never` or `auto`. +# if `always`, there are no exceptions +# if `auto`, the `with` parameter is superseded when seen fit (most of the time, +# but not after `begin match` for example) +# if `never`, `with` is only applied if the match block starts a line. +# +# For example, the following is not indented if set to `always`: +# let f = function +# ^^| Foo -> bar +strict_with = never + +# Controls indentation after the `else` keyword. `always` indents after the +# `else` keyword normally, like after `then`. +# If set to `never', the `else` keyword won't indent when followed by a newline. +# `auto` indents after `else` unless in a few "unclosable" cases (`let in`, +# `match`...). +# +# For example, with `strict_else=never`: +# if cond then +# foo +# else +# bar; +# baz +# `never` is discouraged if you may encounter code like this example, +# because it hides the scoping error (`baz` is always executed) +strict_else = always + +# Ocp-indent will normally try to preserve your in-comment indentation, as long +# as it respects the left-margin or starts with `(*\n`. Setting this to `true` +# forces alignment within comments. +strict_comments = false + +# Toggles preference of column-alignment over line indentation for most +# of the common operators and after mid-line opening parentheses. +# +# for example (left: `false'; right: `true') +# let f x = x # let f x = x +# + y # + y +align_ops = true + +# Function parameters are normally indented one level from the line containing +# the function. This option can be used to have them align relative to the +# column of the function body instead. +# if set to `always`, always align below the function +# if `auto`, only do that when seen fit (mainly, after arrows) +# if `never`, no alignment whatsoever +# +# for example (left: `never`; right: `always or `auto) +# match foo with # match foo with +# | _ -> some_fun # | _ -> some_fun +# ^^parameter # ^^parameter +align_params = auto + + +# +# SYNTAX EXTENSIONS +# + +# You can also add syntax extensions (as per the --syntax command-line option): +# syntax = mll lwt From f1214e01a39dbd214d6945559af195cd8bd44d98 Mon Sep 17 00:00:00 2001 From: rand00 Date: Thu, 3 Feb 2022 14:32:04 +0100 Subject: [PATCH 13/21] Views: Syntax betterings for readability --- lib/views.ml | 131 +++++++++++++++++++++++++++------------------------ 1 file changed, 69 insertions(+), 62 deletions(-) diff --git a/lib/views.ml b/lib/views.ml index a0a144a..6daf8e8 100644 --- a/lib/views.ml +++ b/lib/views.ml @@ -242,7 +242,8 @@ module Builds = struct Uuidm.pp latest_build.Builder_db.Build.uuid] [txtf "%a" pp_ptime latest_build.Builder_db.Build.start]; H.txt " "; - ] @ (match latest_artifact with + ] + @ (match latest_artifact with | Some main_binary -> artifact ~basename:true @@ -252,17 +253,19 @@ module Builds = struct | None -> [ txtf "Build failure: %a" Builder.pp_execution_result latest_build.Builder_db.Build.result ] - ) @ [ H.br () ] + ) + @ [ H.br () ] let make_jobs jobs = jobs |> List.map (fun (job_name, synopsis, platform_builds) -> - H.li ([ - H.a ~a:H.[a_href ("job/" ^ job_name ^ "/")] - [H.txt job_name]; - H.br (); - H.txt (Option.value ~default:"" synopsis); - H.br () - ] + H.li ( + [ + H.a ~a:H.[a_href ("job/" ^ job_name ^ "/")] + [H.txt job_name]; + H.br (); + H.txt (Option.value ~default:"" synopsis); + H.br () + ] @ List.concat_map (make_platform_builds ~job_name) platform_builds) ) @@ -279,13 +282,12 @@ module Builds = struct layout ~title:"Reproducible OPAM builds" (make_header @ make_body section_job_map - @ - [ H.p [ - H.txt "View the latest failed builds "; - H.a ~a:H.[a_href "/failed-builds/"] - [H.txt "here"]; - H.txt "." - ]]) + @ [ H.p [ + H.txt "View the latest failed builds "; + H.a ~a:H.[a_href "/failed-builds/"] + [H.txt "here"]; + H.txt "." + ]]) end @@ -295,52 +297,57 @@ module Job = struct layout ~nav:(`Job (job_name, platform)) ~title:(Fmt.str "Job %s %a" job_name pp_platform platform) - ((H.h1 [txtf "Job %s %a" job_name pp_platform platform] :: - (match readme with - | None -> [] - | Some data -> - [ - H.h2 ~a:H.[a_id "readme"] [H.txt "README"]; - H.a ~a:H.[a_href "#builds"] [H.txt "Skip to builds"]; - H.Unsafe.data (Utils.Omd.html_of_string data) - ])) @ - [ - H.h2 ~a:H.[a_id "builds"] [H.txt "Builds"]; - H.a ~a:H.[a_href "#readme"] [H.txt "Back to readme"]; - H.ul (List.map (fun (build, main_binary) -> - H.li ([ - check_icon build.Builder_db.Build.result; - txtf " %s " build.platform; - H.a ~a:H.[ - Fmt.kstr a_href "/job/%s/build/%a/" - job_name - Uuidm.pp build.Builder_db.Build.uuid ] - [ - txtf "%a" pp_ptime build.Builder_db.Build.start; - ]; - H.txt " "; - ] @ match main_binary with - | Some main_binary -> - artifact - ~basename:true - ~job_name - ~build - ~file:main_binary - | None -> - [ txtf "Build failure: %a" Builder.pp_execution_result - build.Builder_db.Build.result ])) - builds); - if failed then - H.p [ - H.txt "Excluding failed builds " ; - H.a ~a:H.[a_href "../"] [H.txt "here"] ; - H.txt "." ] - else - H.p [ - H.txt "Including failed builds " ; - H.a ~a:H.[a_href "failed/"] [H.txt "here"] ; - H.txt "." ] - ]) + ( + (H.h1 [txtf "Job %s %a" job_name pp_platform platform] :: + (match readme with + | None -> [] + | Some data -> + [ + H.h2 ~a:H.[a_id "readme"] [H.txt "README"]; + H.a ~a:H.[a_href "#builds"] [H.txt "Skip to builds"]; + H.Unsafe.data (Utils.Omd.html_of_string data) + ]) + ) + @ [ + H.h2 ~a:H.[a_id "builds"] [H.txt "Builds"]; + H.a ~a:H.[a_href "#readme"] [H.txt "Back to readme"]; + H.ul ( + builds |> List.map (fun (build, main_binary) -> + H.li ( + [ + check_icon build.Builder_db.Build.result; + txtf " %s " build.platform; + H.a ~a:H.[ + Fmt.kstr a_href "/job/%s/build/%a/" + job_name + Uuidm.pp build.Builder_db.Build.uuid ] + [ + txtf "%a" pp_ptime build.Builder_db.Build.start; + ]; + H.txt " "; + ] + @ match main_binary with + | Some main_binary -> + artifact + ~basename:true + ~job_name + ~build + ~file:main_binary + | None -> + [ txtf "Build failure: %a" Builder.pp_execution_result + build.Builder_db.Build.result ])) + ); + if failed then + H.p [ + H.txt "Excluding failed builds " ; + H.a ~a:H.[a_href "../"] [H.txt "here"] ; + H.txt "." ] + else + H.p [ + H.txt "Including failed builds " ; + H.a ~a:H.[a_href "failed/"] [H.txt "here"] ; + H.txt "." ] + ]) end From b0fc7c1d9d6b13f2ca4240e9e705776805d0e3ee Mon Sep 17 00:00:00 2001 From: rand00 Date: Thu, 3 Feb 2022 14:38:48 +0100 Subject: [PATCH 14/21] Views.breadcrumbs: Consistent style of multiline tuples in list --- lib/views.ml | 24 ++++++++++++++---------- 1 file changed, 14 insertions(+), 10 deletions(-) diff --git a/lib/views.ml b/lib/views.ml index 6daf8e8..8e4a0cf 100644 --- a/lib/views.ml +++ b/lib/views.ml @@ -112,20 +112,24 @@ let layout ?include_static_css ?(nav=`Default) ~title body = job_name pp_platform_query (Some build.Builder_db.Build.platform) ); - txtf "Build %a" pp_ptime build.Builder_db.Build.start, - Fmt.str "/job/%s/build/%a/" - job_name - Uuidm.pp build.Builder_db.Build.uuid; + ( + txtf "Build %a" pp_ptime build.Builder_db.Build.start, + Fmt.str "/job/%s/build/%a/" + job_name + Uuidm.pp build.Builder_db.Build.uuid + ); ] | `Comparison ((job_left, build_left), (job_right, build_right)) -> to_nav [ H.txt "Home", "/"; - txtf "Comparison between %s@%a and %s@%a" - job_left pp_ptime build_left.Builder_db.Build.start - job_right pp_ptime build_right.Builder_db.Build.start, - Fmt.str "/compare/%a/%a/" - Uuidm.pp build_left.uuid - Uuidm.pp build_right.uuid; + ( + txtf "Comparison between %s@%a and %s@%a" + job_left pp_ptime build_left.Builder_db.Build.start + job_right pp_ptime build_right.Builder_db.Build.start, + Fmt.str "/compare/%a/%a/" + Uuidm.pp build_left.uuid + Uuidm.pp build_right.uuid + ); ] in (*> Note: Last declared CSS wins - so one can override here*) From f0632dff6f1edb43ee99c584d28d96ad6eef6b90 Mon Sep 17 00:00:00 2001 From: rand00 Date: Thu, 3 Feb 2022 14:42:33 +0100 Subject: [PATCH 15/21] Views: More syntax + separated out failed-builds footer in Builds --- lib/views.ml | 52 +++++++++++++++++++++++++++------------------------- 1 file changed, 27 insertions(+), 25 deletions(-) diff --git a/lib/views.ml b/lib/views.ml index 8e4a0cf..ca194d7 100644 --- a/lib/views.ml +++ b/lib/views.ml @@ -179,11 +179,10 @@ let artifact Fpath.pp filepath in [ - H.a ~a:H.[a_href artifact_link] - [ - if basename then H.txt (Fpath.basename filepath) - else txtf "%a" Fpath.pp filepath - ]; + H.a ~a:H.[a_href artifact_link] [ + if basename then H.txt (Fpath.basename filepath) + else txtf "%a" Fpath.pp filepath + ]; H.txt " "; H.code [txtf "SHA256:%a" Hex.pp (Hex.of_cstruct sha256)]; txtf " (%a)" Fmt.byte_size size; @@ -212,22 +211,21 @@ module Builds = struct H.txt ". Contact team@robur.coop if you have any questions or \ suggestions."; ]; - H.form ~a:H.[a_action "/hash"; a_method `Get] - [ - H.label [ - H.txt "Search artifact by SHA256"; - H.br (); - H.input ~a:H.[ - a_input_type `Search; - a_id "sha256"; - a_name "sha256"; - ] (); - ]; + H.form ~a:H.[a_action "/hash"; a_method `Get] [ + H.label [ + H.txt "Search artifact by SHA256"; + H.br (); H.input ~a:H.[ - a_input_type `Submit; - a_value "Search"; + a_input_type `Search; + a_id "sha256"; + a_name "sha256"; ] (); ]; + H.input ~a:H.[ + a_input_type `Submit; + a_value "Search"; + ] (); + ]; ] let make_platform_builds ~job_name (platform, latest_build, latest_artifact) = @@ -270,7 +268,8 @@ module Builds = struct H.txt (Option.value ~default:"" synopsis); H.br () ] - @ List.concat_map (make_platform_builds ~job_name) platform_builds) + @ List.concat_map (make_platform_builds ~job_name) platform_builds + ) ) let make_body section_job_map = @@ -282,16 +281,19 @@ module Builds = struct in Utils.String_map.fold aux section_job_map [] + let make_failed_builds = + [ H.p [ + H.txt "View the latest failed builds "; + H.a ~a:H.[a_href "/failed-builds/"] + [H.txt "here"]; + H.txt "." + ]] + let make section_job_map = layout ~title:"Reproducible OPAM builds" (make_header @ make_body section_job_map - @ [ H.p [ - H.txt "View the latest failed builds "; - H.a ~a:H.[a_href "/failed-builds/"] - [H.txt "here"]; - H.txt "." - ]]) + @ make_failed_builds) end From 5a6ce19c335522c55c8b78abc767a203bc3c12a5 Mon Sep 17 00:00:00 2001 From: rand00 Date: Thu, 3 Feb 2022 14:50:17 +0100 Subject: [PATCH 16/21] Views.Job: Separated nested list-generation out into named functions --- lib/views.ml | 118 ++++++++++++++++++++++++++++----------------------- 1 file changed, 64 insertions(+), 54 deletions(-) diff --git a/lib/views.ml b/lib/views.ml index ca194d7..7d2b6d9 100644 --- a/lib/views.ml +++ b/lib/views.ml @@ -299,61 +299,71 @@ end module Job = struct + let make_header ~job_name ~platform ~readme = + H.h1 [txtf "Job %s %a" job_name pp_platform platform] + :: ( + match readme with + | None -> [] + | Some data -> + [ + H.h2 ~a:H.[a_id "readme"] [H.txt "README"]; + H.a ~a:H.[a_href "#builds"] [H.txt "Skip to builds"]; + H.Unsafe.data (Utils.Omd.html_of_string data) + ] + ) + + let make_build ~job_name (build, main_binary) = + H.li ( + [ + check_icon build.Builder_db.Build.result; + txtf " %s " build.platform; + H.a ~a:H.[ + Fmt.kstr a_href "/job/%s/build/%a/" + job_name + Uuidm.pp build.Builder_db.Build.uuid ] + [ + txtf "%a" pp_ptime build.Builder_db.Build.start; + ]; + H.txt " "; + ] + @ match main_binary with + | Some main_binary -> + artifact + ~basename:true + ~job_name + ~build + ~file:main_binary + | None -> + [ txtf "Build failure: %a" Builder.pp_execution_result + build.Builder_db.Build.result ] + ) + + let make_builds ~failed ~job_name builds = + [ + H.h2 ~a:H.[a_id "builds"] [H.txt "Builds"]; + H.a ~a:H.[a_href "#readme"] [H.txt "Back to readme"]; + H.ul (builds |> List.map (make_build ~job_name)); + if failed then + H.p [ + H.txt "Excluding failed builds " ; + H.a ~a:H.[a_href "../"] [H.txt "here"] ; + H.txt "." ] + else + H.p [ + H.txt "Including failed builds " ; + H.a ~a:H.[a_href "failed/"] [H.txt "here"] ; + H.txt "." ] + ] + + let make_body ~failed ~job_name ~platform ~readme builds = + make_header ~job_name ~platform ~readme + @ make_builds ~failed ~job_name builds + let make ~failed ~job_name ~platform ~readme builds = - layout - ~nav:(`Job (job_name, platform)) - ~title:(Fmt.str "Job %s %a" job_name pp_platform platform) - ( - (H.h1 [txtf "Job %s %a" job_name pp_platform platform] :: - (match readme with - | None -> [] - | Some data -> - [ - H.h2 ~a:H.[a_id "readme"] [H.txt "README"]; - H.a ~a:H.[a_href "#builds"] [H.txt "Skip to builds"]; - H.Unsafe.data (Utils.Omd.html_of_string data) - ]) - ) - @ [ - H.h2 ~a:H.[a_id "builds"] [H.txt "Builds"]; - H.a ~a:H.[a_href "#readme"] [H.txt "Back to readme"]; - H.ul ( - builds |> List.map (fun (build, main_binary) -> - H.li ( - [ - check_icon build.Builder_db.Build.result; - txtf " %s " build.platform; - H.a ~a:H.[ - Fmt.kstr a_href "/job/%s/build/%a/" - job_name - Uuidm.pp build.Builder_db.Build.uuid ] - [ - txtf "%a" pp_ptime build.Builder_db.Build.start; - ]; - H.txt " "; - ] - @ match main_binary with - | Some main_binary -> - artifact - ~basename:true - ~job_name - ~build - ~file:main_binary - | None -> - [ txtf "Build failure: %a" Builder.pp_execution_result - build.Builder_db.Build.result ])) - ); - if failed then - H.p [ - H.txt "Excluding failed builds " ; - H.a ~a:H.[a_href "../"] [H.txt "here"] ; - H.txt "." ] - else - H.p [ - H.txt "Including failed builds " ; - H.a ~a:H.[a_href "failed/"] [H.txt "here"] ; - H.txt "." ] - ]) + let nav = `Job (job_name, platform) in + let title = Fmt.str "Job %s %a" job_name pp_platform platform in + layout ~nav ~title @@ make_body ~failed ~job_name ~platform ~readme builds + end From 36f20640348ade028bac11bf23a2a9d84a3373a0 Mon Sep 17 00:00:00 2001 From: rand00 Date: Thu, 3 Feb 2022 14:55:17 +0100 Subject: [PATCH 17/21] .ocp-indent: Marked non-default value --- .ocp-indent | 1 + 1 file changed, 1 insertion(+) diff --git a/.ocp-indent b/.ocp-indent index 5953521..e791b33 100644 --- a/.ocp-indent +++ b/.ocp-indent @@ -61,6 +61,7 @@ ppx_stritem_ext = 2 # ) # ) # ) # ) max_indent = 2 +# < default = 4 # From a28b0829b36833c51b14e17b3114c30e041545b5 Mon Sep 17 00:00:00 2001 From: rand00 Date: Thu, 3 Feb 2022 19:39:51 +0100 Subject: [PATCH 18/21] .ocp-indent & Views: Changed max_indent to 4 - the default --- .ocp-indent | 3 +- lib/views.ml | 286 +++++++++++++++++++++++++-------------------------- 2 files changed, 144 insertions(+), 145 deletions(-) diff --git a/.ocp-indent b/.ocp-indent index e791b33..8782308 100644 --- a/.ocp-indent +++ b/.ocp-indent @@ -60,8 +60,7 @@ ppx_stritem_ext = 2 # x) # x) # ) # ) # ) # ) -max_indent = 2 -# < default = 4 +max_indent = 4 # diff --git a/lib/views.ml b/lib/views.ml index 7d2b6d9..a717e9c 100644 --- a/lib/views.ml +++ b/lib/views.ml @@ -11,15 +11,15 @@ let check_icon result = match result with | Builder.Exited 0 -> H.span ~a:H.[ - a_style "color: green; cursor: pointer;"; - a_titlef "%a" Builder.pp_execution_result result; - ] + a_style "color: green; cursor: pointer;"; + a_titlef "%a" Builder.pp_execution_result result; + ] [H.txt "☑"] | _ -> H.span ~a:H.[ - a_style "color: red; cursor: pointer;"; - a_titlef "%a" Builder.pp_execution_result result; - ] + a_style "color: red; cursor: pointer;"; + a_titlef "%a" Builder.pp_execution_result result; + ] [H.txt "☒"] type nav = [ @@ -86,8 +86,8 @@ let layout ?include_static_css ?(nav=`Default) ~title body = H.nav [ H.ul ( List.map (fun (desc, href) -> - H.li [H.a ~a:H.[a_href href] [desc]] - ) kvs + H.li [H.a ~a:H.[a_href href] [desc]] + ) kvs )] in match nav with @@ -140,29 +140,29 @@ let layout ?include_static_css ?(nav=`Default) ~title body = [H.style ~a:H.[a_mime_type "text/css"] static_css]) (H.body [ - breadcrumb; - H.main body - ]) + breadcrumb; + H.main body + ]) let toggleable ?(hidden=true) ~id ~description content = let checked = if hidden then [] else H.[a_checked ()] in H.div [ H.label ~a:H.[ - a_label_for id; - a_class ["toggleable-descr"]; - ] + a_label_for id; + a_class ["toggleable-descr"]; + ] [H.txt description]; H.input ~a:(checked @ H.[ - a_input_type `Checkbox; - a_id id; - a_style "display: none;"; - ]) (); + a_input_type `Checkbox; + a_id id; + a_style "display: none;"; + ]) (); H.div ~a:H.[ - a_class ["toggleable"] - ] + a_class ["toggleable"] + ] content; ] @@ -216,15 +216,15 @@ module Builds = struct H.txt "Search artifact by SHA256"; H.br (); H.input ~a:H.[ - a_input_type `Search; - a_id "sha256"; - a_name "sha256"; - ] (); + a_input_type `Search; + a_id "sha256"; + a_name "sha256"; + ] (); ]; H.input ~a:H.[ - a_input_type `Submit; - a_value "Search"; - ] (); + a_input_type `Submit; + a_value "Search"; + ] (); ]; ] @@ -246,31 +246,31 @@ module Builds = struct H.txt " "; ] @ (match latest_artifact with - | Some main_binary -> - artifact - ~basename:true - ~job_name - ~build:latest_build - ~file:main_binary - | None -> - [ txtf "Build failure: %a" Builder.pp_execution_result - latest_build.Builder_db.Build.result ] - ) + | Some main_binary -> + artifact + ~basename:true + ~job_name + ~build:latest_build + ~file:main_binary + | None -> + [ txtf "Build failure: %a" Builder.pp_execution_result + latest_build.Builder_db.Build.result ] + ) @ [ H.br () ] let make_jobs jobs = jobs |> List.map (fun (job_name, synopsis, platform_builds) -> - H.li ( - [ - H.a ~a:H.[a_href ("job/" ^ job_name ^ "/")] - [H.txt job_name]; - H.br (); - H.txt (Option.value ~default:"" synopsis); - H.br () - ] - @ List.concat_map (make_platform_builds ~job_name) platform_builds + H.li ( + [ + H.a ~a:H.[a_href ("job/" ^ job_name ^ "/")] + [H.txt job_name]; + H.br (); + H.txt (Option.value ~default:"" synopsis); + H.br () + ] + @ List.concat_map (make_platform_builds ~job_name) platform_builds + ) ) - ) let make_body section_job_map = let aux section jobs acc = @@ -283,11 +283,11 @@ module Builds = struct let make_failed_builds = [ H.p [ - H.txt "View the latest failed builds "; - H.a ~a:H.[a_href "/failed-builds/"] - [H.txt "here"]; - H.txt "." - ]] + H.txt "View the latest failed builds "; + H.a ~a:H.[a_href "/failed-builds/"] + [H.txt "here"]; + H.txt "." + ]] let make section_job_map = layout ~title:"Reproducible OPAM builds" @@ -318,9 +318,9 @@ module Job = struct check_icon build.Builder_db.Build.result; txtf " %s " build.platform; H.a ~a:H.[ - Fmt.kstr a_href "/job/%s/build/%a/" - job_name - Uuidm.pp build.Builder_db.Build.uuid ] + Fmt.kstr a_href "/job/%s/build/%a/" + job_name + Uuidm.pp build.Builder_db.Build.uuid ] [ txtf "%a" pp_ptime build.Builder_db.Build.start; ]; @@ -337,7 +337,7 @@ module Job = struct [ txtf "Build failure: %a" Builder.pp_execution_result build.Builder_db.Build.result ] ) - + let make_builds ~failed ~job_name builds = [ H.h2 ~a:H.[a_id "builds"] [H.txt "Builds"]; @@ -363,7 +363,7 @@ module Job = struct let nav = `Job (job_name, platform) in let title = Fmt.str "Job %s %a" job_name pp_platform platform in layout ~nav ~title @@ make_body ~failed ~job_name ~platform ~readme builds - + end @@ -394,48 +394,48 @@ module Job_build = struct H.ul [ H.li [ H.a ~a:H.[ - Fmt.kstr a_href "/job/%s/build/%a/console" name Uuidm.pp build.uuid - ] [H.txt "Console output"]; + Fmt.kstr a_href "/job/%s/build/%a/console" name Uuidm.pp build.uuid + ] [H.txt "Console output"]; ]; H.li [ H.a ~a:H.[ - Fmt.kstr a_href "/job/%s/build/%a/script" name Uuidm.pp build.uuid - ] [H.txt "Build script"]; + Fmt.kstr a_href "/job/%s/build/%a/script" name Uuidm.pp build.uuid + ] [H.txt "Build script"]; ] ]; H.h3 [H.txt "Build artifacts"]; H.dl (List.concat_map (fun (file:Builder_db.file) -> - let (`Hex sha256_hex) = Hex.of_cstruct file.sha256 in - [ - H.dt [H.a - ~a:H.[Fmt.kstr a_href "f/%a" Fpath.pp file.filepath] - [H.code [txtf "%a" Fpath.pp file.filepath]]]; - H.dd [ - H.code [H.txt "SHA256:"; H.txt sha256_hex]; - txtf " (%a)" Fmt.byte_size file.size; - ]; - ]) - artifacts); + let (`Hex sha256_hex) = Hex.of_cstruct file.sha256 in + [ + H.dt [H.a + ~a:H.[Fmt.kstr a_href "f/%a" Fpath.pp file.filepath] + [H.code [txtf "%a" Fpath.pp file.filepath]]]; + H.dd [ + H.code [H.txt "SHA256:"; H.txt sha256_hex]; + txtf " (%a)" Fmt.byte_size file.size; + ]; + ]) + artifacts); H.h3 [ txtf "Reproduced by %d builds" (List.length (same_input_same_output @ different_input_same_output))] ; H.ul ((List.map (fun (build:Builder_db.Build.t) -> - H.li [ - txtf "on %s, same input, " build.platform; - H.a ~a:H.[Fmt.kstr a_href "/job/%s/build/%a/" name Uuidm.pp build.uuid] - [txtf "%a" pp_ptime build.start] - ]) - same_input_same_output) @ + H.li [ + txtf "on %s, same input, " build.platform; + H.a ~a:H.[Fmt.kstr a_href "/job/%s/build/%a/" name Uuidm.pp build.uuid] + [txtf "%a" pp_ptime build.start] + ]) + same_input_same_output) @ List.map (fun (build':Builder_db.Build.t) -> - H.li [ - txtf "on %s, different input, " build'.platform; - H.a ~a:H.[ - Fmt.kstr a_href "/compare/%a/%a/" - Uuidm.pp build'.uuid - Uuidm.pp build.uuid] - [txtf "%a" pp_ptime build'.start] - ]) + H.li [ + txtf "on %s, different input, " build'.platform; + H.a ~a:H.[ + Fmt.kstr a_href "/compare/%a/%a/" + Uuidm.pp build'.uuid + Uuidm.pp build.uuid] + [txtf "%a" pp_ptime build'.start] + ]) different_input_same_output) ] @ (if same_input_different_output = [] then @@ -444,14 +444,14 @@ module Job_build = struct [ H.h3 [H.txt "Same input, different output (not reproducible!)"]; H.ul ( List.map (fun (build':Builder_db.Build.t) -> - H.li [ - txtf "on %s, " build'.platform ; - H.a ~a:H.[ - Fmt.kstr a_href "/compare/%a/%a/" - Uuidm.pp build'.uuid - Uuidm.pp build.uuid] - [txtf "%a" pp_ptime build'.start] - ]) + H.li [ + txtf "on %s, " build'.platform ; + H.a ~a:H.[ + Fmt.kstr a_href "/compare/%a/%a/" + Uuidm.pp build'.uuid + Uuidm.pp build.uuid] + [txtf "%a" pp_ptime build'.start] + ]) same_input_different_output) ] ) @@ -498,21 +498,21 @@ module Job_build = struct [ (* [ H.h3 [txt "Analysis"] ]; *) [ H.p [ - let src = Fmt.str "/job/%s/build/%a/vizdependencies" name Uuidm.pp uuid in - H.iframe ~a:H.[ - a_src src; - a_title "Opam dependencies"; - a_style viz_style_deps - ] [] - ]]; + let src = Fmt.str "/job/%s/build/%a/vizdependencies" name Uuidm.pp uuid in + H.iframe ~a:H.[ + a_src src; + a_title "Opam dependencies"; + a_style viz_style_deps + ] [] + ]]; if not @@ contains_debug_bin artifacts then [] else [ H.p [ let src = Fmt.str "/job/%s/build/%a/viztreemap" name Uuidm.pp uuid in H.iframe ~a:H.[ - a_src src; - a_title "Binary dissection"; - a_style viz_style_treemap - ] [] + a_src src; + a_title "Binary dissection"; + a_style viz_style_treemap + ] [] ]]; ] |> List.flatten @@ -579,45 +579,45 @@ let key_value_changes xs = let packages packages = OpamPackage.Set.elements packages |> List.concat_map (fun p -> [ - txtf "%a" Opamdiff.pp_opampackage p; - H.br (); - ]) + txtf "%a" Opamdiff.pp_opampackage p; + H.br (); + ]) let package_diffs diffs = List.concat_map (fun pd -> [ - txtf "%a" Opamdiff.pp_version_diff pd; - H.br (); - ]) + txtf "%a" Opamdiff.pp_version_diff pd; + H.br (); + ]) diffs let opam_diffs diffs = List.concat_map (fun pd -> - H.h4 [ txtf "%a" Opamdiff.pp_opam_diff pd ] :: - (match pd.Opamdiff.build with None -> [] | Some a -> - let l, r = Opamdiff.commands_to_strings a in - [ - H.h5 [ H.txt "build instruction (without common prefix) modifications, old:" ] ; - H.code (List.concat_map (fun s -> [ H.txt s ; H.br () ]) l) ; - H.h5 [ H.txt "new" ] ; - H.code (List.concat_map (fun s -> [ H.txt s ; H.br () ]) r) - ]) @ - (match pd.Opamdiff.install with None -> [] | Some a -> - let l, r = Opamdiff.commands_to_strings a in - [ - H.h5 [ H.txt "install instruction (without common prefix) modifications, old:" ] ; - H.code (List.concat_map (fun s -> [ H.txt s ; H.br () ]) l) ; - H.h5 [ H.txt "new" ] ; - H.code (List.concat_map (fun s -> [ H.txt s ; H.br () ]) r) - ]) @ - (match pd.Opamdiff.url with None -> [] | Some a -> - let l, r = Opamdiff.opt_url_to_string a in - [ - H.h5 [ H.txt "URL" ] ; - txtf "old: %s" l; - H.br (); - txtf "new: %s" r - ]) @ - [ H.br () ]) + H.h4 [ txtf "%a" Opamdiff.pp_opam_diff pd ] :: + (match pd.Opamdiff.build with None -> [] | Some a -> + let l, r = Opamdiff.commands_to_strings a in + [ + H.h5 [ H.txt "build instruction (without common prefix) modifications, old:" ] ; + H.code (List.concat_map (fun s -> [ H.txt s ; H.br () ]) l) ; + H.h5 [ H.txt "new" ] ; + H.code (List.concat_map (fun s -> [ H.txt s ; H.br () ]) r) + ]) @ + (match pd.Opamdiff.install with None -> [] | Some a -> + let l, r = Opamdiff.commands_to_strings a in + [ + H.h5 [ H.txt "install instruction (without common prefix) modifications, old:" ] ; + H.code (List.concat_map (fun s -> [ H.txt s ; H.br () ]) l) ; + H.h5 [ H.txt "new" ] ; + H.code (List.concat_map (fun s -> [ H.txt s ; H.br () ]) r) + ]) @ + (match pd.Opamdiff.url with None -> [] | Some a -> + let l, r = Opamdiff.opt_url_to_string a in + [ + H.h5 [ H.txt "URL" ] ; + txtf "old: %s" l; + H.br (); + txtf "new: %s" r + ]) @ + [ H.br () ]) diffs let compare_builds @@ -656,10 +656,10 @@ let compare_builds pp_platform (Some build_right.platform)]; ]; H.h3 [ H.a ~a:H.[ - Fmt.kstr a_href "/compare/%a/%a/" - Uuidm.pp build_right.uuid - Uuidm.pp build_left.uuid ] - [H.txt "Compare in reverse direction"]] ; + Fmt.kstr a_href "/compare/%a/%a/" + Uuidm.pp build_right.uuid + Uuidm.pp build_left.uuid ] + [H.txt "Compare in reverse direction"]] ; H.ul [ H.li [ H.a ~a:H.[a_href "#opam-packages-removed"] @@ -755,8 +755,8 @@ let failed_builds ~start ~count builds = H.ul (List.map build builds); H.p [ txtf "View the next %d failed builds " count; H.a ~a:H.[ - Fmt.kstr a_href "/failed-builds/?count=%d&start=%d" - count (start + count) ] + Fmt.kstr a_href "/failed-builds/?count=%d&start=%d" + count (start + count) ] [ H.txt "here"]; H.txt "."; ] From cb11326cd4a6b2e0345008b2f1afdce766a4162e Mon Sep 17 00:00:00 2001 From: rand00 Date: Thu, 3 Feb 2022 20:06:55 +0100 Subject: [PATCH 19/21] Views.Job_build: Separated body html out into named functions --- lib/views.ml | 186 +++++++++++++++++++++++++++++++-------------------- 1 file changed, 115 insertions(+), 71 deletions(-) diff --git a/lib/views.ml b/lib/views.ml index a717e9c..4f2b388 100644 --- a/lib/views.ml +++ b/lib/views.ml @@ -375,6 +375,109 @@ module Job_build = struct in List.exists check artifacts + let make_artifacts ~artifacts = + let aux (file:Builder_db.file) = + let (`Hex sha256_hex) = Hex.of_cstruct file.sha256 in + [ + H.dt [ + H.a ~a:H.[Fmt.kstr a_href "f/%a" Fpath.pp file.filepath] + [H.code [txtf "%a" Fpath.pp file.filepath]] ]; + H.dd [ + H.code [H.txt "SHA256:"; H.txt sha256_hex]; + txtf " (%a)" Fmt.byte_size file.size; + ]; + ] + in + [ + H.h3 [H.txt "Build artifacts"]; + H.dl (List.concat_map aux artifacts) + ] + + let make_reproductions + ~name + ~(build:Builder_db.Build.t) + ~same_input_same_output + ~different_input_same_output + = + let same_input_same_output_html = + List.map (fun (build:Builder_db.Build.t) -> + H.li [ + txtf "on %s, same input, " build.platform; + H.a ~a:H.[Fmt.kstr a_href "/job/%s/build/%a/" name Uuidm.pp build.uuid] + [txtf "%a" pp_ptime build.start] + ]) + same_input_same_output + in + let different_input_same_output_html = + List.map (fun (build':Builder_db.Build.t) -> + H.li [ + txtf "on %s, different input, " build'.platform; + H.a ~a:H.[ + Fmt.kstr a_href "/compare/%a/%a/" + Uuidm.pp build'.uuid + Uuidm.pp build.uuid] + [txtf "%a" pp_ptime build'.start] + ]) + different_input_same_output + in + [ + H.h3 [ + txtf "Reproduced by %d builds" + (List.length (same_input_same_output @ different_input_same_output))] ; + H.ul @@ ( + same_input_same_output_html + @ different_input_same_output_html + ) + ] + + let make_not_reproducible + ~(build:Builder_db.Build.t) + ~same_input_different_output + = + if same_input_different_output = [] then + [] + else + [ H.h3 [H.txt "Same input, different output (not reproducible!)"]; + H.ul ( + List.map (fun (build':Builder_db.Build.t) -> + H.li [ + txtf "on %s, " build'.platform ; + H.a ~a:H.[ + Fmt.kstr a_href "/compare/%a/%a/" + Uuidm.pp build'.uuid + Uuidm.pp build.uuid] + [txtf "%a" pp_ptime build'.start] + ]) + same_input_different_output) + ] + + let make_comparisons_same_platform + ~(build:Builder_db.Build.t) + ~previous + ~latest + ~next + = + [ + H.h3 [H.txt "Comparisons with other builds on the same platform"]; + let opt_build (ctx, build') = + match build' with + | Some b when not (Uuidm.equal build.uuid b.Builder_db.Build.uuid) -> + [ H.li [ H.txt ctx; + H.a ~a:[ + Fmt.kstr H.a_href "/compare/%a/%a/" + Uuidm.pp b.uuid + Uuidm.pp build.uuid ] + [txtf "%a" pp_ptime b.start]] + ] + | _ -> [] + in + H.ul + (List.concat_map opt_build + [ ("Latest build ", latest) ; + ("Later build with different output ", next) ; + ("Earlier build with different output ", previous) ]) + ] + let make_build_info ~name ~delta @@ -403,78 +506,19 @@ module Job_build = struct ] [H.txt "Build script"]; ] ]; - H.h3 [H.txt "Build artifacts"]; - H.dl (List.concat_map (fun (file:Builder_db.file) -> - let (`Hex sha256_hex) = Hex.of_cstruct file.sha256 in - [ - H.dt [H.a - ~a:H.[Fmt.kstr a_href "f/%a" Fpath.pp file.filepath] - [H.code [txtf "%a" Fpath.pp file.filepath]]]; - H.dd [ - H.code [H.txt "SHA256:"; H.txt sha256_hex]; - txtf " (%a)" Fmt.byte_size file.size; - ]; - ]) - artifacts); - H.h3 [ - txtf "Reproduced by %d builds" - (List.length (same_input_same_output @ different_input_same_output))] ; - H.ul - ((List.map (fun (build:Builder_db.Build.t) -> - H.li [ - txtf "on %s, same input, " build.platform; - H.a ~a:H.[Fmt.kstr a_href "/job/%s/build/%a/" name Uuidm.pp build.uuid] - [txtf "%a" pp_ptime build.start] - ]) - same_input_same_output) @ - List.map (fun (build':Builder_db.Build.t) -> - H.li [ - txtf "on %s, different input, " build'.platform; - H.a ~a:H.[ - Fmt.kstr a_href "/compare/%a/%a/" - Uuidm.pp build'.uuid - Uuidm.pp build.uuid] - [txtf "%a" pp_ptime build'.start] - ]) - different_input_same_output) - ] - @ (if same_input_different_output = [] then - [] - else - [ H.h3 [H.txt "Same input, different output (not reproducible!)"]; - H.ul ( - List.map (fun (build':Builder_db.Build.t) -> - H.li [ - txtf "on %s, " build'.platform ; - H.a ~a:H.[ - Fmt.kstr a_href "/compare/%a/%a/" - Uuidm.pp build'.uuid - Uuidm.pp build.uuid] - [txtf "%a" pp_ptime build'.start] - ]) - same_input_different_output) - ] - ) - @ [ - H.h3 [H.txt "Comparisons with other builds on the same platform"]; - let opt_build (ctx, build') = - match build' with - | Some b when not (Uuidm.equal build.uuid b.Builder_db.Build.uuid) -> - [ H.li [ H.txt ctx; - H.a ~a:[ - Fmt.kstr H.a_href "/compare/%a/%a/" - Uuidm.pp b.uuid - Uuidm.pp build.uuid ] - [txtf "%a" pp_ptime b.start]] - ] - | _ -> [] - in - H.ul - (List.concat_map opt_build - [ ("Latest build ", latest) ; - ("Later build with different output ", next) ; - ("Earlier build with different output ", previous) ]) ] + @ make_artifacts ~artifacts + @ make_reproductions + ~name + ~build + ~same_input_same_output + ~different_input_same_output + @ make_not_reproducible ~build ~same_input_different_output + @ make_comparisons_same_platform + ~build + ~previous + ~latest + ~next let viz_style_deps = " width: 46em; From 7633b63f21e762774867c7dc804348843d81a4c0 Mon Sep 17 00:00:00 2001 From: rand00 Date: Thu, 3 Feb 2022 20:11:36 +0100 Subject: [PATCH 20/21] Views.Job_build: Avoiding too much indentation with current ocp-indent settings via less nesting --- lib/views.ml | 41 ++++++++++++++++++++++------------------- 1 file changed, 22 insertions(+), 19 deletions(-) diff --git a/lib/views.ml b/lib/views.ml index 4f2b388..98d254d 100644 --- a/lib/views.ml +++ b/lib/views.ml @@ -539,26 +539,29 @@ module Job_build = struct " let make_viz_section ~name ~artifacts ~uuid = - [ - (* [ H.h3 [txt "Analysis"] ]; *) - [ H.p [ - let src = Fmt.str "/job/%s/build/%a/vizdependencies" name Uuidm.pp uuid in - H.iframe ~a:H.[ - a_src src; - a_title "Opam dependencies"; - a_style viz_style_deps - ] [] - ]]; + let viz_deps_iframe = [ + let src = Fmt.str "/job/%s/build/%a/vizdependencies" name Uuidm.pp uuid in + H.iframe ~a:H.[ + a_src src; + a_title "Opam dependencies"; + a_style viz_style_deps + ] [] + ] + in + let viz_treemap_iframe = lazy [ + let src = Fmt.str "/job/%s/build/%a/viztreemap" name Uuidm.pp uuid in + H.iframe ~a:H.[ + a_src src; + a_title "Binary dissection"; + a_style viz_style_treemap + ] [] + ] + in + List.flatten [ + [ H.p viz_deps_iframe]; if not @@ contains_debug_bin artifacts then [] else [ - H.p [ - let src = Fmt.str "/job/%s/build/%a/viztreemap" name Uuidm.pp uuid in - H.iframe ~a:H.[ - a_src src; - a_title "Binary dissection"; - a_style viz_style_treemap - ] [] - ]]; - ] |> List.flatten + H.p @@ Lazy.force viz_treemap_iframe ]; + ] let make ~name From a601c143d6ecbe6006a7e751382b1e18406027c6 Mon Sep 17 00:00:00 2001 From: rand00 Date: Thu, 3 Feb 2022 20:15:14 +0100 Subject: [PATCH 21/21] Views.Job_build: Fixed for 80-col rule --- lib/views.ml | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lib/views.ml b/lib/views.ml index 98d254d..347864a 100644 --- a/lib/views.ml +++ b/lib/views.ml @@ -643,7 +643,8 @@ let opam_diffs diffs = (match pd.Opamdiff.build with None -> [] | Some a -> let l, r = Opamdiff.commands_to_strings a in [ - H.h5 [ H.txt "build instruction (without common prefix) modifications, old:" ] ; + H.h5 [ H.txt "build instruction (without common prefix) \ + modifications, old:" ] ; H.code (List.concat_map (fun s -> [ H.txt s ; H.br () ]) l) ; H.h5 [ H.txt "new" ] ; H.code (List.concat_map (fun s -> [ H.txt s ; H.br () ]) r) @@ -651,7 +652,8 @@ let opam_diffs diffs = (match pd.Opamdiff.install with None -> [] | Some a -> let l, r = Opamdiff.commands_to_strings a in [ - H.h5 [ H.txt "install instruction (without common prefix) modifications, old:" ] ; + H.h5 [ H.txt "install instruction (without common prefix) \ + modifications, old:" ] ; H.code (List.concat_map (fun s -> [ H.txt s ; H.br () ]) l) ; H.h5 [ H.txt "new" ] ; H.code (List.concat_map (fun s -> [ H.txt s ; H.br () ]) r)