diff --git a/bin/builder_web_app.ml b/bin/builder_web_app.ml index 22c4151..fb53cb8 100644 --- a/bin/builder_web_app.ml +++ b/bin/builder_web_app.ml @@ -81,28 +81,28 @@ let init_influx name data = let run_batch_viz ~cachedir ~datadir ~configdir = let open Rresult.R.Infix in begin - let script = Fpath.(configdir / "batch-viz.sh") + let script = Fpath.(configdir / "batch-viz.sh") and script_log = Fpath.(cachedir / "batch-viz.log") - and viz_script = Fpath.(configdir / "upload-hooks" / "visualizations.sh") + and viz_script = Fpath.(configdir / "upload-hooks" / "visualizations.sh") in Bos.OS.File.exists script >>= fun script_exists -> if not script_exists then begin Logs.warn (fun m -> m "Didn't find %s" (Fpath.to_string script)); Ok () end else - let args = + let args = [ "--cache-dir=" ^ Fpath.to_string cachedir; "--data-dir=" ^ Fpath.to_string datadir; "--viz-script=" ^ Fpath.to_string viz_script ] |> List.map (fun s -> "\"" ^ String.escaped s ^ "\"") |> String.concat " " in - (*> Note: The reason for appending, is that else a new startup could + (*> Note: The reason for appending, is that else a new startup could overwrite an existing running batch's log*) (Fpath.to_string script ^ " " ^ args ^ " 2>&1 >> " ^ Fpath.to_string script_log ^ " &") - |> Sys.command + |> Sys.command |> ignore |> Result.ok end diff --git a/lib/views.ml b/lib/views.ml index 63e4b44..ea4c754 100644 --- a/lib/views.ml +++ b/lib/views.ml @@ -98,7 +98,7 @@ let make_breadcrumbs nav = txtf "Job %s" job_name, Link.Job.make ~job_name (); ( txtf "%a" pp_platform platform, - Link.Job.make ~job_name ~queries () + Link.Job.make ~job_name ~queries () ) ] | `Build (job_name, build) -> @@ -122,7 +122,7 @@ let make_breadcrumbs nav = 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, - Link.Compare_builds.make + Link.Compare_builds.make ~left:build_left.uuid ~right:build_right.uuid () ); @@ -218,7 +218,7 @@ let page_not_found ~target ~referer = | None -> [] | Some prev_url -> [ H.p [ - H.txt "Go back to "; + H.txt "Go back to "; H.a ~a:H.[ a_href prev_url ] [ H.txt prev_url ]; ]; ] @@ -397,7 +397,7 @@ module Job = struct check_icon build.Builder_db.Build.result; txtf " %s " build.platform; H.a ~a:H.[ - a_href @@ Link.Job_build.make + a_href @@ Link.Job_build.make ~job_name ~build:build.Builder_db.Build.uuid () ] [ @@ -435,7 +435,7 @@ module Job = struct H.txt "." ] else H.p [ - H.txt "Including failed builds " ; + H.txt "Including failed builds " ; H.a ~a:H.[ a_href @@ Link.Job.make_failed ~job_name ~queries () ] @@ -586,7 +586,7 @@ module Job_build = struct | Some b when not (Uuidm.equal build.uuid b.Builder_db.Build.uuid) -> [ H.li [ H.txt ctx; H.a ~a:[ - H.a_href @@ Link.Compare_builds.make + H.a_href @@ Link.Compare_builds.make ~left:b.uuid ~right:build.uuid () ] [txtf "%a" pp_ptime b.start]] @@ -683,10 +683,10 @@ module Job_build = struct font-weight: bold;\ " ] - + let make_viz_section ~job_name ~artifacts ~uuid = - let viz_deps = - let iframe = + let viz_deps = + let iframe = let src = Link.Job_build_artifact.make ~job_name ~build:uuid ~artifact:`Viz_dependencies () in H.iframe ~a:H.[ @@ -697,11 +697,11 @@ module Job_build = struct in let descr_txt = "\ This is an interactive visualization of dependencies, \ -focusing on how shared dependencies are. +focusing on how shared dependencies are. In the middle you see the primary package. \ Edges shoot out to its direct \ -dependencies, including build dependencies. +dependencies, including build dependencies. From these direct dependencies, edges shoot out to sets \ of their own respective direct dependencies. \ @@ -718,7 +718,7 @@ dependency.\ [ iframe; H.br (); make_description descr_txt ] in let viz_treemap = lazy ( - let iframe = + let iframe = let src = Link.Job_build_artifact.make ~job_name ~build:uuid ~artifact:`Viz_treemap () in H.iframe ~a:H.[ @@ -730,7 +730,7 @@ dependency.\ let descr_txt = "\ This interactive treemap shows the space-usage of modules/libraries inside the \ ELF binary. You can get more info from each block by \ -hovering over them. +hovering over them. On top of the treemap there is a scale, showing how much space the \ treemap itself constitutes of the binary, the excluded symbols/modules \ diff --git a/test/router.ml b/test/router.ml index b3eaccd..1cafd5a 100644 --- a/test/router.ml +++ b/test/router.ml @@ -2,7 +2,7 @@ module Param_verification = struct (*> None is 'verified'*) - type t = wrong_type option + type t = wrong_type option [@@deriving yojson,show,eq] and wrong_type = { @@ -24,9 +24,9 @@ module Param_verification = struct param; expected = "Uuidm.t" } - + end - + let verify parameters req = let verified_params = List.fold_left (fun acc p -> @@ -53,7 +53,7 @@ let find_parameters path = else None) (String.split_on_char '/' path) - + let router = (* XXX: this relies on [Builder_web.routes] only using {data,cache,config}dir * in the handlers which are never called here. The path /nonexistant is @@ -83,7 +83,7 @@ let test_link method_ target () = Alcotest.(check' (result Param_verification.alcotyp string) ~msg:"param-verification" ~actual:body ~expected:(Ok None)) -let test_link_artifact artifact = +let test_link_artifact artifact = let job_name = "test" in let build = Uuidm.v `V4 in test_link `GET @@ @@ -147,7 +147,7 @@ let () = end; test_case "Link.Failed_builds.make" `Quick begin test_link `GET @@ - Builder_web.Link.Failed_builds.make ~count:2 ~start:1 () + Builder_web.Link.Failed_builds.make ~count:2 ~start:1 () end; ]; (* this doesn't actually test the redirects, unfortunately *)