robur/builder-web
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Added dependencies visualization to builds pages

Browse source
This commit is contained in:
rand00 2022-01-24 14:35:59 +01:00 committed by Reynir Björnsson
parent 95ef54fc82
commit 64cf4fc350
2 changed files with 43 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

46
lib/builder_web.ml
View file

@ -183,20 +183,29 @@ let add_routes datadir =
|> Lwt_result.ok
in
let treemap_visualization_cmd ~elf_path ~elf_size =
let builder_viz_cmd =
(*> goto make work across different cwd's*)
let bin = "_build/default/bin/visualizations/builder_viz.exe" in
bin, [| bin; "treemap"; elf_path; Int.to_string elf_size |]
let visualization_cmd args =
(*> goto make work across different cwd's*)
let bin = "_build/default/bin/visualizations/builder_viz.exe" in
let cmd = bin, Array.of_list (bin :: args)
in
Lwt_process.pread ~stderr:`Dev_null builder_viz_cmd
Lwt_process.pread ~stderr:`Dev_null cmd
|> Lwt_result.catch
|> Lwt_result.map_err (fun exn ->
Printexc.to_string exn, `Internal_Server_Error
)
in
let treemap_visualization_cmd ~elf_path ~elf_size =
[ "treemap"; elf_path; Int.to_string elf_size ]
|> visualization_cmd
in
let dependencies_visualization_cmd ~opam_switch_path =
[ "dependencies"; opam_switch_path ]
|> visualization_cmd
in
let job_build_treemap req =
let job_build_viztreemap req =
let _job_name = Dream.param "job" req
and build = Dream.param "build" req in
get_uuid build >>= fun uuid ->
@ -224,6 +233,26 @@ let add_routes datadir =
Lwt_result.ok (Dream.html svg_html)
in
let job_build_vizdependencies req =
let _job_name = Dream.param "job" req
and build = Dream.param "build" req in
get_uuid build >>= fun uuid ->
(
let opam_switch_path = Fpath.(v "opam-switch") in
Dream.sql req (Model.build_artifact uuid opam_switch_path)
)
|> if_error "Error getting job build"
~log:(fun e -> Log.warn (fun m -> m "Error getting job data: %a" pp_error e))
>>= fun opam_switch ->
let datadir = Dream.global datadir_global req in
let opam_switch_path = Fpath.(
datadir // opam_switch.Builder_db.localpath
|> to_string
) in
dependencies_visualization_cmd ~opam_switch_path >>= fun svg_html ->
Lwt_result.ok (Dream.html svg_html)
in
let job_build req =
let job_name = Dream.param "job" req
and build = Dream.param "build" req in
@ -439,7 +468,8 @@ let add_routes datadir =
Dream.get "/job/:job/build/:build/" (w job_build);
Dream.get "/job/:job/build/:build/f/**" (w job_build_file);
Dream.get "/job/:job/build/:build/main-binary" (w redirect_main_binary);
Dream.get "/job/:job/build/:build/treemap" (w job_build_treemap);
Dream.get "/job/:job/build/:build/viztreemap" (w job_build_viztreemap);
Dream.get "/job/:job/build/:build/vizdependencies" (w job_build_vizdependencies);
Dream.get "/job/:job/build/:build/script" (w (job_build_static_file `Script));
Dream.get "/job/:job/build/:build/console" (w (job_build_static_file `Console));
Dream.get "/failed-builds/" (w failed_builds);

6
lib/views.ml
View file

@ -359,9 +359,13 @@ let job_build
let analysis_section = if not @@ contains_debug_bin artifacts then [] else [
h3 [txt "Analysis"];
p [
let src = Fmt.str "/job/%s/build/%a/treemap" name Uuidm.pp uuid in
let src = Fmt.str "/job/%s/build/%a/viztreemap" name Uuidm.pp uuid in
let style = "width: 50em; height: 54.0em" in (*treemap tries to be square*)
iframe ~a:[ a_src src; a_title "Binary dissection"; a_style style ] [] ];
p [
let src = Fmt.str "/job/%s/build/%a/vizdependencies" name Uuidm.pp uuid in
let style = "width: 50em; height: 54.0em" in
iframe ~a:[ a_src src; a_title "Opam dependencies"; a_style style ] [] ];
]
in
let body =