From e5e7e7d3fa5ed36b5bf813531cee4b55877652c3 Mon Sep 17 00:00:00 2001 From: rand00 Date: Thu, 17 Mar 2022 16:32:21 +0100 Subject: [PATCH 1/8] Opam_graph: Added new functions for stats + coloring nodes based on this + some styling --- src/opam_graph.ml | 83 ++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 67 insertions(+), 16 deletions(-) diff --git a/src/opam_graph.ml b/src/opam_graph.ml index 64a60d7..fe43e24 100644 --- a/src/opam_graph.ml +++ b/src/opam_graph.ml @@ -115,8 +115,23 @@ type assoc_node = { name : string; uniqueness_postfix : string; } + type assoc_graph = (assoc_node * (assoc_node list)) list +module SMap = Map.Make(String) + +type assoc_stats = int SMap.t + +let calc_sharing_stats (deps:graph) : assoc_stats = + Name_map.fold (fun _pkg deps acc_stats -> + Name_set.fold (fun pkg acc_stats -> + let pkg_name = OpamPackage.Name.to_string pkg in + acc_stats |> SMap.update pkg_name (function + | None -> Some 1 + | Some count -> Some (succ count)) + ) deps acc_stats + ) deps.nodes SMap.empty + module Ui = struct let dependencies ?(transitive=true) data : assoc_graph = @@ -266,7 +281,15 @@ module Render = struct .deps-line { stroke-width: 0.4; - stroke: bisque; + stroke: #80746e; +} + +.deps-node { + fill: #ccc; +} + +.deps-root { + fill: black; } .deps-layer2_deps.deps-bg { @@ -356,12 +379,16 @@ svg { ] [] ] - let make_node ~pos ~radius ~text ~classes = + let make_node ?(with_node_class=true) ~pos ~radius ~text ~classes () = let title = make_title ~text in (*> todo; why is this not in Tyxml - browser support missing?*) let a_transform_origin = Svg.Unsafe.string_attrib "transform-origin" in + let classes = + if not with_node_class then classes else + scoped_class "node" :: classes + in let a = Svg.[ - a_class (scoped_class "node" :: classes); + a_class classes; a_transform_origin @@ sprintf "%f %f" pos.x pos.y; ] in Svg.g ~a (title :: make_circle ~pos ~radius) @@ -392,7 +419,7 @@ svg { scoped_class dep.name; scoped_class "direct_dep" ] in - make_node ~pos ~radius ~text ~classes + make_node ~pos ~radius ~text ~classes () ) let make_direct_dep_edge_css dep = @@ -521,7 +548,7 @@ svg { scoped_class layer2_dep.name; scoped_class "layer2_dep"; ] in - make_node ~pos ~radius:dot_radius ~text ~classes + make_node ~pos ~radius:dot_radius ~text ~classes () ) let grid_pos ~cell_width i = @@ -581,7 +608,7 @@ svg { scoped_class layer2_dep.name; scoped_class "layer2_dep"; ] in - let visual_svg = make_node ~pos ~radius:dot_radius ~text ~classes in + let visual_svg = make_node ~pos ~radius:dot_radius ~text ~classes () in let _hitbox_svg = make_hitbox_square ~text ~classes ~center_pos:pos @@ -593,7 +620,7 @@ svg { let make_layer2_deps ~deps_w_positions = let open Gg in deps_w_positions |> List.mapi - (fun i ((dep, direct_dep_pos), layer2_deps) -> + (fun i ((_dep, direct_dep_pos), layer2_deps) -> let layer2_deps_center = let direct_dep_pos = V2.(v direct_dep_pos.x direct_dep_pos.y) in let center = V2.v center.x center.y in @@ -610,9 +637,8 @@ svg { and classes = [ scoped_class "layer2_deps"; scoped_class "bg"; - scoped_class dep.name ] in - make_node ~pos ~radius ~text ~classes + make_node ~with_node_class:false ~pos ~radius ~text ~classes () in let edge = let pos0 = direct_dep_pos in @@ -632,6 +658,7 @@ svg { .deps-direct_dep.%s:hover ~ .deps-node.deps-layer2_dep.%s { fill: #5454ff; + filter: brightness(1.0) !important; } |} (scoped_class dep.name) (scoped_class shared_dep) ) @@ -695,16 +722,36 @@ svg { ] [ stop ~a:[ a_offset @@ `Percentage 0.; - a_stop_color "bisque" + a_stop_color "#80746e"; (* "bisque" *) ] []; stop ~a:[ a_offset @@ `Percentage 100.; - a_stop_color "bisque"; a_stop_opacity 0. + a_stop_color "#80746e"; (* "bisque" *) + a_stop_opacity 0. ] [] ] ]] - let of_assoc (graph:assoc_graph) : _ output = + let make_deps_sharing_css (sharing_stats:assoc_stats) = + let max_count = + SMap.fold + (fun _pkg count max_count -> Int.max max_count count) + sharing_stats 0 + |> float + in + SMap.fold (fun pkg count acc -> + let pct_count = float count /. max_count in (*goo*) + let css = sprintf "\ + .%s.%s {\ + filter: brightness(%f);\ + }\ + " (scoped_class "node") (scoped_class pkg) pct_count + in + css :: acc + ) sharing_stats [] + |> merge_css + + let of_assoc ~(sharing_stats:assoc_stats) (graph:assoc_graph) : _ output = match graph with | [] -> { svg_content = []; svg_attr = []; css = "" } | (root_pkg, direct_deps) :: layer2_deps -> @@ -718,15 +765,16 @@ svg { scoped_class root_pkg.name; scoped_class "root" ] in - make_node ~pos ~radius ~text ~classes + make_node ~pos ~radius ~text ~classes () in let deps_svgs, deps_css = make_deps layer2_deps in + let deps_sharing_css = make_deps_sharing_css sharing_stats in let svg_attr = Svg.[ a_viewBox (0., 0., 100., 100.); a_class [ scoped_class "svg-wrap" ]; ] in let svg_content = svg_defs @ (root_svg :: deps_svgs) in - let css = merge_css [ initial_css; deps_css ] in + let css = merge_css [ initial_css; deps_css; deps_sharing_css ] in { svg_content; svg_attr; css } let pp ppf html = @@ -742,8 +790,11 @@ svg { let merge_css = String.concat "\n" - let of_assoc ?(override_css="") (graph:assoc_graph) : t = - let svg = Svg.of_assoc graph in + let of_assoc + ?(override_css="") + ?(sharing_stats:assoc_stats=SMap.empty) + (graph:assoc_graph) : t = + let svg = Svg.of_assoc ~sharing_stats graph in H.html (H.head (H.title (H.txt "Dependencies")) From baffa71bf4e933d350e39a1d2af1f8a15eae13b0 Mon Sep 17 00:00:00 2001 From: rand00 Date: Fri, 18 Mar 2022 11:25:53 +0100 Subject: [PATCH 2/8] Opam_graph: Fixed layer2-dep hitbox selectors + reenabled --- src/opam_graph.ml | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/opam_graph.ml b/src/opam_graph.ml index fe43e24..b1e4f76 100644 --- a/src/opam_graph.ml +++ b/src/opam_graph.ml @@ -304,6 +304,10 @@ module Render = struct transform: scale(1.4); } +.deps-layer2_dep.deps-hitbox:hover + .deps-node { + transform: scale(1.4); +} + |} (* disabled CSS @@ -609,11 +613,11 @@ svg { scoped_class "layer2_dep"; ] in let visual_svg = make_node ~pos ~radius:dot_radius ~text ~classes () in - let _hitbox_svg = + let hitbox_svg = make_hitbox_square ~text ~classes ~center_pos:pos ~width:cell_width in - [ (* hitbox_svg; *)visual_svg ] + [ hitbox_svg; visual_svg ] ) |> List.flatten From 538640d23b2e28b21409a90f235197b286b67db4 Mon Sep 17 00:00:00 2001 From: rand00 Date: Fri, 18 Mar 2022 12:05:00 +0100 Subject: [PATCH 3/8] Opam_graph: WIP: Adding reverse-deps stats to pop-ups --- src/opam_graph.ml | 37 ++++++++++++++++++++++++++----------- 1 file changed, 26 insertions(+), 11 deletions(-) diff --git a/src/opam_graph.ml b/src/opam_graph.ml index b1e4f76..ee48b44 100644 --- a/src/opam_graph.ml +++ b/src/opam_graph.ml @@ -411,14 +411,19 @@ svg { let title = make_title ~text in Svg.g ~a [ title; make_line ~pos0 ~pos1 ] - let make_direct_dep_text dep ~layer2_deps = - sprintf "Direct dependency: %s\nDirect dependencies: %d" - dep.name (List.length layer2_deps) + let make_direct_dep_text dep ~layer2_deps ~(sharing_stats:assoc_stats) = + sprintf + "Direct dependency: %s\n\ + Amount of direct dependencies: %d\n\ + Amount of reverse dependencies: %d" + dep.name + (List.length layer2_deps) + (SMap.find_opt dep.name sharing_stats |> Option.value ~default:0) - let make_direct_deps_nodes ~deps_w_positions = + let make_direct_deps_nodes ~deps_w_positions ~(sharing_stats:assoc_stats) = deps_w_positions |> List.map (fun ((dep, pos), layer2_deps) -> let radius = root_radius *. 0.7 - and text = make_direct_dep_text dep ~layer2_deps + and text = make_direct_dep_text dep ~layer2_deps ~sharing_stats and classes = [ scoped_class dep.name; scoped_class "direct_dep" @@ -497,7 +502,7 @@ svg { in Svg.g ~a [ title; make_triangle ~top:pos0 ~left ~right ] - let make_direct_deps_edges ~deps_w_positions = + let make_direct_deps_edges ~deps_w_positions ~(sharing_stats:assoc_stats) = let open Gg in let n_edges = deps_w_positions |> List.length in let svg = @@ -513,7 +518,11 @@ svg { let pos0 = V2.(pos0_rel + center) in { x = V2.x pos0; y = V2.y pos0 }, pos1_rel_angle in - let text = make_direct_dep_text dep ~layer2_deps in + let text = + make_direct_dep_text dep + ~layer2_deps + ~sharing_stats + in let classes = [ scoped_class dep.name; scoped_class "direct_dep" @@ -694,7 +703,7 @@ svg { ) |> merge_css - let make_deps (deps:assoc_graph) = + let make_deps ~(sharing_stats:assoc_stats) (deps:assoc_graph) = let deps_w_positions = let open Gg in let len_deps = List.length deps in @@ -708,8 +717,13 @@ svg { ) in let direct_deps_edges, direct_deps_edges_css = - make_direct_deps_edges ~deps_w_positions - and direct_deps_nodes = make_direct_deps_nodes ~deps_w_positions + make_direct_deps_edges + ~deps_w_positions + ~sharing_stats + and direct_deps_nodes = + make_direct_deps_nodes + ~sharing_stats + ~deps_w_positions and layer2_deps = make_layer2_deps ~deps_w_positions and shared_deps_css = make_shared_deps_css ~deps_w_positions in @@ -771,7 +785,8 @@ svg { ] in make_node ~pos ~radius ~text ~classes () in - let deps_svgs, deps_css = make_deps layer2_deps in + let deps_svgs, deps_css = + make_deps ~sharing_stats layer2_deps in let deps_sharing_css = make_deps_sharing_css sharing_stats in let svg_attr = Svg.[ a_viewBox (0., 0., 100., 100.); From e0c3dd0f23fd455c4fbf69a0f9fe9b128203823c Mon Sep 17 00:00:00 2001 From: rand00 Date: Fri, 18 Mar 2022 12:56:08 +0100 Subject: [PATCH 4/8] Opam_graph: Some cleanup + small optimization --- src/opam_graph.ml | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/src/opam_graph.ml b/src/opam_graph.ml index ee48b44..a429d1d 100644 --- a/src/opam_graph.ml +++ b/src/opam_graph.ml @@ -79,7 +79,7 @@ let pp_graph ppf graph = (Name_set.elements deps)))) graph.nodes -let dependencies ?(transitive=false) (switch : OpamFile.SwitchExport.t) = +let dependencies ~transitive (switch : OpamFile.SwitchExport.t) = let root_pkg = root switch in let top = root_pkg.OpamPackage.name in let graph = { top ; nodes = Name_map.empty } in @@ -124,9 +124,9 @@ type assoc_stats = int SMap.t let calc_sharing_stats (deps:graph) : assoc_stats = Name_map.fold (fun _pkg deps acc_stats -> - Name_set.fold (fun pkg acc_stats -> - let pkg_name = OpamPackage.Name.to_string pkg in - acc_stats |> SMap.update pkg_name (function + Name_set.fold (fun dep acc_stats -> + let dep_name = OpamPackage.Name.to_string dep in + acc_stats |> SMap.update dep_name (function | None -> Some 1 | Some count -> Some (succ count)) ) deps acc_stats @@ -136,7 +136,7 @@ module Ui = struct let dependencies ?(transitive=true) data : assoc_graph = (*> todo can be made more efficient*) - let all_direct_deps = dependencies data in + let all_direct_deps = dependencies ~transitive:false data in let root = all_direct_deps.top in let root_str = OpamPackage.Name.to_string root in @@ -144,9 +144,10 @@ module Ui = struct all_direct_deps.nodes |> Name_map.find root in - (*> todo can be made more efficient*) let all_transitive_deps = - dependencies ~transitive data in + if transitive = false then all_direct_deps else + dependencies ~transitive data + in let direct_deps_w_transitive_deps = direct_deps |> Name_set.elements From 0668da34bfc5b2c9c021008f8c2f67514f7fe266 Mon Sep 17 00:00:00 2001 From: rand00 Date: Fri, 18 Mar 2022 13:12:57 +0100 Subject: [PATCH 5/8] Opam_graph: Added reverse-deps stats to layer2-nodes --- src/opam_graph.ml | 34 +++++++++++++++++++++++++++------- 1 file changed, 27 insertions(+), 7 deletions(-) diff --git a/src/opam_graph.ml b/src/opam_graph.ml index a429d1d..cb642ed 100644 --- a/src/opam_graph.ml +++ b/src/opam_graph.ml @@ -421,6 +421,14 @@ svg { (List.length layer2_deps) (SMap.find_opt dep.name sharing_stats |> Option.value ~default:0) + (*> todo add amount of direct deps?*) + let make_layer2_dep_text dep ~(sharing_stats:assoc_stats) = + sprintf + "Indirect dependency: %s\n\ + Amount of reverse dependencies: %d" + dep + (SMap.find_opt dep sharing_stats |> Option.value ~default:0) + let make_direct_deps_nodes ~deps_w_positions ~(sharing_stats:assoc_stats) = deps_w_positions |> List.map (fun ((dep, pos), layer2_deps) -> let radius = root_radius *. 0.7 @@ -546,7 +554,10 @@ svg { svg, css (*goto values might need to be updated to fit new viewbox*) - let make_layer2_nodes_spiral ~layer2_deps ~layer2_deps_center = + let make_layer2_nodes_spiral + ~layer2_deps + ~layer2_deps_center + ~(sharing_stats:assoc_stats) = let open Gg in let dot_radius = root_radius *. 0.25 in layer2_deps |> List.mapi (fun i' layer2_dep -> @@ -557,7 +568,8 @@ svg { let pos_rel = V2.(v pos_radius pos_angle |> of_polar) in let pos = V2.(layer2_deps_center + pos_rel) in let pos = { x = V2.x pos; y = V2.y pos } in - let text = layer2_dep.name in + let text = + make_layer2_dep_text layer2_dep.name ~sharing_stats in let classes = [ scoped_class layer2_dep.name; scoped_class "layer2_dep"; @@ -610,14 +622,17 @@ svg { ] in Svg.g ~a (title :: make_square ~center_pos ~width) - let make_layer2_nodes_grid ~layer2_deps ~layer2_deps_center = + let make_layer2_nodes_grid + ~layer2_deps + ~layer2_deps_center + ~(sharing_stats:assoc_stats) = let open Gg in let dot_radius = 0.5 in let cell_width = dot_radius *. 2.5 in layer2_deps |> List.mapi (fun i layer2_dep -> let pos = V2.(layer2_deps_center + grid_pos ~cell_width i) in let pos = { x = V2.x pos; y = V2.y pos } in - let text = layer2_dep.name in + let text = make_layer2_dep_text layer2_dep.name ~sharing_stats in let classes = [ scoped_class layer2_dep.name; scoped_class "layer2_dep"; @@ -631,7 +646,7 @@ svg { ) |> List.flatten - let make_layer2_deps ~deps_w_positions = + let make_layer2_deps ~deps_w_positions ~(sharing_stats:assoc_stats) = let open Gg in deps_w_positions |> List.mapi (fun i ((_dep, direct_dep_pos), layer2_deps) -> @@ -642,7 +657,12 @@ svg { in V2.(mult * (direct_dep_pos - center) + center) in - let nodes = make_layer2_nodes_grid ~layer2_deps ~layer2_deps_center in + let nodes = + make_layer2_nodes_grid + ~layer2_deps + ~layer2_deps_center + ~sharing_stats + in let bg = let pos = { x = V2.x layer2_deps_center; y = V2.y layer2_deps_center } @@ -725,7 +745,7 @@ svg { make_direct_deps_nodes ~sharing_stats ~deps_w_positions - and layer2_deps = make_layer2_deps ~deps_w_positions + and layer2_deps = make_layer2_deps ~deps_w_positions ~sharing_stats and shared_deps_css = make_shared_deps_css ~deps_w_positions in let svg = direct_deps_edges @ direct_deps_nodes @ layer2_deps in From 1f3513e1eea571d3b218bec6e98ee4071ef368b7 Mon Sep 17 00:00:00 2001 From: rand00 Date: Fri, 18 Mar 2022 13:15:49 +0100 Subject: [PATCH 6/8] Opam_graph: Todo-comment for a more useful sharing-coloring, excluding 'ocaml' + 'dune' from max-value calc --- src/opam_graph.ml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/opam_graph.ml b/src/opam_graph.ml index cb642ed..df36bd1 100644 --- a/src/opam_graph.ml +++ b/src/opam_graph.ml @@ -774,6 +774,9 @@ svg { let make_deps_sharing_css (sharing_stats:assoc_stats) = let max_count = SMap.fold + (*> todo: exclude a certain set of pkgs from being taken into consideration here + .. and remember to limit their following pct-count too + *) (fun _pkg count max_count -> Int.max max_count count) sharing_stats 0 |> float From 9b4af7cfd4797423a4668d94d11b378208291e1e Mon Sep 17 00:00:00 2001 From: rand00 Date: Mon, 21 Mar 2022 10:49:21 +0100 Subject: [PATCH 7/8] Opam_graph: Scaled new sharing-color brightness to fit the counts better --- src/opam_graph.ml | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/src/opam_graph.ml b/src/opam_graph.ml index df36bd1..b9b2a88 100644 --- a/src/opam_graph.ml +++ b/src/opam_graph.ml @@ -773,16 +773,15 @@ svg { let make_deps_sharing_css (sharing_stats:assoc_stats) = let max_count = + (*> todo; would be more correct to use the count of nodes in dep-graph*) SMap.fold - (*> todo: exclude a certain set of pkgs from being taken into consideration here - .. and remember to limit their following pct-count too - *) (fun _pkg count max_count -> Int.max max_count count) sharing_stats 0 - |> float + |> float + |> ( *. ) 0.2 in SMap.fold (fun pkg count acc -> - let pct_count = float count /. max_count in (*goo*) + let pct_count = Float.min 1. (float count /. max_count) in let css = sprintf "\ .%s.%s {\ filter: brightness(%f);\ From 5f1c15e82f6f6704498782e760036b738524ec6b Mon Sep 17 00:00:00 2001 From: rand00 Date: Tue, 22 Mar 2022 19:05:48 +0100 Subject: [PATCH 8/8] Opam_graph: Switched from 'Int.max' to 'max' to support older ocaml versions --- src/opam_graph.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/opam_graph.ml b/src/opam_graph.ml index b9b2a88..b9b5f9d 100644 --- a/src/opam_graph.ml +++ b/src/opam_graph.ml @@ -775,7 +775,7 @@ svg { let max_count = (*> todo; would be more correct to use the count of nodes in dep-graph*) SMap.fold - (fun _pkg count max_count -> Int.max max_count count) + (fun _pkg count max_count -> max max_count count) sharing_stats 0 |> float |> ( *. ) 0.2