diff --git a/.ocp-indent b/.ocp-indent new file mode 100644 index 0000000..8782308 --- /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 = 4 + + +# +# 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 diff --git a/lib/builder_web.ml b/lib/builder_web.ml index 1ce8fda..7a5831f 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 = @@ -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 = @@ -279,7 +283,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 @@ -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 @@ -493,7 +502,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/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 diff --git a/lib/views.ml b/lib/views.ml index 51c1e8f..347864a 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:[ - a_style "color: green; cursor: pointer;"; - a_titlef "%a" Builder.pp_execution_result result; - ] - [txt "☑"] + H.span ~a:H.[ + a_style "color: green; cursor: pointer;"; + a_titlef "%a" Builder.pp_execution_result result; + ] + [H.txt "☑"] | _ -> - span ~a:[ - a_style "color: red; cursor: pointer;"; - a_titlef "%a" Builder.pp_execution_result result; - ] - [txt "☒"] + H.span ~a:H.[ + a_style "color: red; cursor: pointer;"; + a_titlef "%a" Builder.pp_execution_result result; + ] + [H.txt "☒"] type nav = [ | `Default @@ -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 { @@ -78,267 +80,294 @@ 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", "/"; 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 [ + H.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", "/"; + H.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 "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 "%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 + ); ] | `Comparison ((job_left, build_left), (job_right, build_right)) -> to_nav [ - 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; + 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 + ); ] in (*> 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:[ - a_label_for id; - a_class ["toggleable-descr"]; - ] - [txt description]; - input - ~a:(checked @ [ +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"]; + ] + [H.txt description]; + H.input + ~a:(checked @ H.[ a_input_type `Checkbox; a_id id; a_style "display: none;"; ]) (); - div - ~a:[ - a_class ["toggleable"] - ] + H.div + ~a:H.[ + a_class ["toggleable"] + ] content; ] -let artifact ?(basename=false) job_name build { Builder_db.filepath; localpath = _; sha256; size } = +let artifact + ~basename + ~job_name + ~build + ~file:{ 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]; - txt " "; - code [txtf "SHA256:%a" Hex.pp (Hex.of_cstruct sha256)]; + 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; ] +module Builds = struct + 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.input ~a:H.[ + a_input_type `Submit; + a_value "Search"; + ] (); + ]; + ] -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"; - ] (); - ]; - ] @ - 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) -> - [ - 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 - [] @ - [ p [ - txt "View the latest failed builds "; - a ~a:[a_href "/failed-builds/"] - [txt "here"]; - txt "." - ]]) + 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 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://") + 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 - 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 + Utils.String_map.fold aux section_job_map [] -let markdown_to_html data = - let omd = Omd.of_string data in - let omd = safe_omd omd in - Omd.to_html omd + 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 + @ make_failed_builds) + +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) - ((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 (markdown_to_html 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 ([ - 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] - [ - txtf "%a" pp_ptime build.Builder_db.Build.start; - ]; - txt " "; - ] @ match main_binary with - | Some main_binary -> - artifact ~basename:true name build main_binary - | None -> - [ txtf "Build failure: %a" Builder.pp_execution_result - build.Builder_db.Build.result ])) - builds); - if failed then - 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 "." ] - ]) + 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 = + 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 + +module Job_build = struct let contains_debug_bin artifacts = let check f = @@ -346,98 +375,152 @@ module Job = struct 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 - = + let make_artifacts ~artifacts = + let aux (file:Builder_db.file) = + let (`Hex sha256_hex) = Hex.of_cstruct file.sha256 in [ - 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"]; - ] + 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; ]; - 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, " 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) - ] + 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 ) - @ [ - 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) ]) + ] + + 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 viz_style_deps = " + 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 + ~(build:Builder_db.Build.t) + ~artifacts + ~same_input_same_output + ~different_input_same_output + ~same_input_different_output + ~latest ~next ~previous + = + [ + 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"]; + ]; + H.li [ + H.a ~a:H.[ + Fmt.kstr a_href "/job/%s/build/%a/script" name Uuidm.pp build.uuid + ] [H.txt "Build script"]; + ] + ]; + ] + @ 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; height: 45.4em; max-width: 100%; @@ -446,7 +529,7 @@ module Job = struct min-height: 39em; " - let viz_style_treemap = " + let viz_style_treemap = " width: 46em; height: 48.4em; max-width: 100%; @@ -455,252 +538,276 @@ 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 = + 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 @@ Lazy.force viz_treemap_iframe ]; + ] - 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 = 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_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 = H.a_style "" in + let style_col_left = + H.a_style "width: 45em; min-width: 43em; padding-left: 2%" in + let style_col_right = H.a_style "width: 50%" in + let body = [ + 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 ] ] ] - 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 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 ] :: - (match pd.Opamdiff.build with None -> [] | Some a -> + 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 -> + (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 - (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" 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)]; - 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)]; + 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)] + [ 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)] + [ 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"]] ; - ul [ - li [ - a ~a:[a_href "#opam-packages-removed"] - [txtf "%d opam packages removed" (OpamPackage.Set.cardinal left)] + 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"]] ; + 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"] - [txtf "%d new opam packages installed" (OpamPackage.Set.cardinal right)] + 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"] - [txtf "%d opam packages with version changes" (List.length 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"] - [txtf "%d opam packages with changes in their opam file" (List.length 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:[Fmt.kstr a_href "/failed-builds/?count=%d&start=%d" count (start + count)] - [ txt "here"]; - txt "."; - ] + ([ + 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 "."; + ] ]) 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