From 3a738d929966263439fbf59e37cc2db309aa5e35 Mon Sep 17 00:00:00 2001 From: rand00 Date: Wed, 5 Jan 2022 20:53:16 +0100 Subject: [PATCH 01/35] app/dune: Gave public name to support dune exec --- app/dune | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/app/dune b/app/dune index 21dd2eb..bf82a93 100644 --- a/app/dune +++ b/app/dune @@ -1,3 +1,4 @@ (executable (name main) - (libraries cmdliner logs logs.fmt opam-graph)) \ No newline at end of file + (public_name opam_graph) + (libraries cmdliner logs logs.fmt opam-graph)) From 84400536089074ed7f2a96abb737d4c04b7404df Mon Sep 17 00:00:00 2001 From: rand00 Date: Thu, 6 Jan 2022 14:53:36 +0100 Subject: [PATCH 02/35] Added output support for graphviz - select by passing 'text'/'dot' before opam-switch file --- app/main.ml | 11 +++++++++-- src/dune | 4 +++- src/opam_graph.ml | 37 +++++++++++++++++++++++++++++++++++-- 3 files changed, 47 insertions(+), 5 deletions(-) diff --git a/app/main.ml b/app/main.ml index 425b9aa..23a472a 100644 --- a/app/main.ml +++ b/app/main.ml @@ -13,10 +13,17 @@ let read_file file = let () = match Sys.argv with - | [| _ ; file |] -> + | [| _ ; output_format; file |] -> ( let switch = read_file file in let data = OpamFile.SwitchExport.read_from_string switch in - Opam_graph.dependencies data + let graph = Opam_graph.dependencies data in + match output_format with + | "text" -> Format.printf "%a" Opam_graph.pp_graph graph + | "dot" -> + let dot = Opam_graph.Dot.of_graph graph in + Format.printf "%a" Opam_graph.Dot.pp dot + | _ -> failwith "Unsupported output format" + ) | _ -> print_endline "expecting exactly one argument"; exit 1 diff --git a/src/dune b/src/dune index 0f484b0..07548d8 100644 --- a/src/dune +++ b/src/dune @@ -1,4 +1,6 @@ (library (name opam_graph) (public_name opam-graph) - (libraries opam-core opam-format)) \ No newline at end of file + (libraries opam-core opam-format dot) + (flags (:standard (-w -27-26))) + ) diff --git a/src/opam_graph.ml b/src/opam_graph.ml index 471de3e..5f2f92e 100644 --- a/src/opam_graph.ml +++ b/src/opam_graph.ml @@ -74,5 +74,38 @@ let dependencies (switch : OpamFile.SwitchExport.t) = in find_deps graph work in - let graph = find_deps graph (Name_set.singleton top) in - Format.printf "%a" pp_graph graph + find_deps graph (Name_set.singleton top) + +module Dot = struct + + type t = Odot.graph + + let of_graph (graph:graph) : t = + let open Odot in + let stmt_list = + Name_map.fold (fun pkg deps acc -> + let stmt = + let pkg_id = Double_quoted_id (OpamPackage.Name.to_string pkg) in + let pkg_point = Edge_node_id (pkg_id, None) in + let deps_points = + Name_set.elements deps + |> List.map (fun p -> + let id = Double_quoted_id (OpamPackage.Name.to_string p) in + Edge_node_id (id, None) + ) + in + let edge = pkg_point, deps_points, [] in + Stmt_edge edge + in + stmt :: acc + ) graph.nodes [] + in + { strict = false; (*todo test params*) + kind = Digraph; + id = None; + stmt_list } + + let pp ppf dot = + Format.fprintf ppf "%s" (Odot.string_of_graph dot) + +end From da630e76940020dac3620cbe7e00fada4e45dd1e Mon Sep 17 00:00:00 2001 From: rand00 Date: Fri, 7 Jan 2022 14:09:34 +0100 Subject: [PATCH 03/35] Implemented transitive deps output ('text_transitive' cli arg) --- app/main.ml | 9 +++++++-- src/opam_graph.ml | 34 ++++++++++++++++++++++++++++++++-- 2 files changed, 39 insertions(+), 4 deletions(-) diff --git a/app/main.ml b/app/main.ml index 23a472a..10af47e 100644 --- a/app/main.ml +++ b/app/main.ml @@ -16,10 +16,15 @@ let () = | [| _ ; output_format; file |] -> ( let switch = read_file file in let data = OpamFile.SwitchExport.read_from_string switch in - let graph = Opam_graph.dependencies data in match output_format with - | "text" -> Format.printf "%a" Opam_graph.pp_graph graph + | "text" -> + let graph = Opam_graph.dependencies data in + Format.printf "%a" Opam_graph.pp_graph graph + | "text_transitive" -> + let graph = Opam_graph.dependencies ~transitive:true data in + Format.printf "%a" Opam_graph.pp_graph graph | "dot" -> + let graph = Opam_graph.dependencies data in let dot = Opam_graph.Dot.of_graph graph in Format.printf "%a" Opam_graph.Dot.pp dot | _ -> failwith "Unsupported output format" diff --git a/src/opam_graph.ml b/src/opam_graph.ml index 5f2f92e..e2bafb4 100644 --- a/src/opam_graph.ml +++ b/src/opam_graph.ml @@ -29,6 +29,33 @@ let direct_dependencies (switch : OpamFile.SwitchExport.t) pkg = let set = filtered_formula_to_pkgs switch (OpamFile.OPAM.depends opam) in filtered_formula_to_pkgs switch ~set (OpamFile.OPAM.depopts opam) +let transitive_dependencies (switch : OpamFile.SwitchExport.t) pkg = + let available = switch.selections.sel_installed in + let rec aux pkg seen_pkgs = + let opam = opam switch pkg in + let set = filtered_formula_to_pkgs switch (OpamFile.OPAM.depends opam) in + let set = filtered_formula_to_pkgs switch ~set (OpamFile.OPAM.depopts opam) in + let transitive_set = + let filtered_set = + set + |> Name_set.filter (fun name -> + OpamPackage.Set.exists + (fun pkg -> pkg.OpamPackage.name = name) + available + && not (Name_set.mem name seen_pkgs) + ) + in + let seen_pkgs = Name_set.union seen_pkgs filtered_set + in + filtered_set + |> Name_set.elements + |> List.concat_map (fun pkg -> aux pkg seen_pkgs |> Name_set.elements) + |> Name_set.of_list + in + Name_set.union set transitive_set + in + aux pkg Name_set.empty + module Name_map = OpamPackage.Name.Map type graph = { @@ -49,7 +76,7 @@ let pp_graph ppf graph = (Name_set.elements deps)))) graph.nodes -let dependencies (switch : OpamFile.SwitchExport.t) = +let dependencies ?(transitive=false) (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 @@ -58,7 +85,10 @@ let dependencies (switch : OpamFile.SwitchExport.t) = match Name_set.choose_opt work with | None -> graph | Some x -> - let deps = direct_dependencies switch x in + let deps = match transitive with + | true -> transitive_dependencies switch x + | false -> direct_dependencies switch x + in let deps = Name_set.filter (fun name -> OpamPackage.Set.exists From fb9581ef2b20b142fb9a8116624db0f1ac21bce5 Mon Sep 17 00:00:00 2001 From: rand00 Date: Fri, 7 Jan 2022 14:38:30 +0100 Subject: [PATCH 04/35] Consistency fix + added skeleton Ui_prototype for graphviz UI mockup --- app/main.ml | 4 ++++ src/opam_graph.ml | 21 ++++++++++++++------- 2 files changed, 18 insertions(+), 7 deletions(-) diff --git a/app/main.ml b/app/main.ml index 10af47e..32f6b03 100644 --- a/app/main.ml +++ b/app/main.ml @@ -27,6 +27,10 @@ let () = let graph = Opam_graph.dependencies data in let dot = Opam_graph.Dot.of_graph graph in Format.printf "%a" Opam_graph.Dot.pp dot + | "dot_proto_ui" -> + let graph = Opam_graph.Ui_prototype.dependencies data in + let dot = Opam_graph.Dot.of_graph graph in + Format.printf "%a" Opam_graph.Dot.pp dot | _ -> failwith "Unsupported output format" ) | _ -> diff --git a/src/opam_graph.ml b/src/opam_graph.ml index e2bafb4..de4498b 100644 --- a/src/opam_graph.ml +++ b/src/opam_graph.ml @@ -25,9 +25,16 @@ let opam (switch : OpamFile.SwitchExport.t) pkg_name = (* TODO build / dev packages *) (* TODO constraints (os = "linux") *) let direct_dependencies (switch : OpamFile.SwitchExport.t) pkg = + let available = switch.selections.sel_installed in let opam = opam switch pkg in let set = filtered_formula_to_pkgs switch (OpamFile.OPAM.depends opam) in filtered_formula_to_pkgs switch ~set (OpamFile.OPAM.depopts opam) + |> Name_set.filter (fun name -> + OpamPackage.Set.exists + (fun pkg -> pkg.OpamPackage.name = name) + available + ) + let transitive_dependencies (switch : OpamFile.SwitchExport.t) pkg = let available = switch.selections.sel_installed in @@ -89,13 +96,6 @@ let dependencies ?(transitive=false) (switch : OpamFile.SwitchExport.t) = | true -> transitive_dependencies switch x | false -> direct_dependencies switch x in - let deps = - Name_set.filter (fun name -> - OpamPackage.Set.exists - (fun pkg -> pkg.OpamPackage.name = name) - available) - deps - in let graph = add_node graph x deps in let work = Name_set.diff @@ -139,3 +139,10 @@ module Dot = struct Format.fprintf ppf "%s" (Odot.string_of_graph dot) end + +module Ui_prototype = struct + + let dependencies data = + failwith "todo" + +end From 35ce449452e062c149f59794aaacf88e751a1972 Mon Sep 17 00:00:00 2001 From: rand00 Date: Mon, 10 Jan 2022 17:48:01 +0100 Subject: [PATCH 05/35] dune: Added rresult --- src/dune | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/dune b/src/dune index 07548d8..9513e4f 100644 --- a/src/dune +++ b/src/dune @@ -1,6 +1,6 @@ (library (name opam_graph) (public_name opam-graph) - (libraries opam-core opam-format dot) + (libraries opam-core opam-format dot rresult) (flags (:standard (-w -27-26))) ) From 0b21c30cc2a28cc61e6fdb3decbaf97769682ecb Mon Sep 17 00:00:00 2001 From: rand00 Date: Mon, 10 Jan 2022 17:49:21 +0100 Subject: [PATCH 06/35] Implemented prototype UIs via graphviz output + Fixed bug introduced earlier --- app/main.ml | 12 ++++-- src/opam_graph.ml | 100 +++++++++++++++++++++++++++++++++++++++------- 2 files changed, 95 insertions(+), 17 deletions(-) diff --git a/app/main.ml b/app/main.ml index 32f6b03..85d82bf 100644 --- a/app/main.ml +++ b/app/main.ml @@ -27,9 +27,15 @@ let () = let graph = Opam_graph.dependencies data in let dot = Opam_graph.Dot.of_graph graph in Format.printf "%a" Opam_graph.Dot.pp dot - | "dot_proto_ui" -> - let graph = Opam_graph.Ui_prototype.dependencies data in - let dot = Opam_graph.Dot.of_graph graph in + | "proto_ui_transitive" -> + let transitive = true in + let graph = Opam_graph.Ui_prototype.dependencies ~transitive data in + let dot = Opam_graph.Dot.of_assoc graph in + Format.printf "%a" Opam_graph.Dot.pp dot + | "proto_ui" -> + let transitive = false in + let graph = Opam_graph.Ui_prototype.dependencies ~transitive data in + let dot = Opam_graph.Dot.of_assoc graph in Format.printf "%a" Opam_graph.Dot.pp dot | _ -> failwith "Unsupported output format" ) diff --git a/src/opam_graph.ml b/src/opam_graph.ml index de4498b..3cb0b37 100644 --- a/src/opam_graph.ml +++ b/src/opam_graph.ml @@ -18,28 +18,21 @@ let filtered_formula_to_pkgs (_switch : OpamFile.SwitchExport.t) ?(set = Name_set.empty) formula = OpamFormula.fold_left (fun acc (name, _) -> Name_set.add name acc) set formula -let opam (switch : OpamFile.SwitchExport.t) pkg_name = +let opam_file (switch : OpamFile.SwitchExport.t) pkg_name = OpamPackage.Name.Map.find pkg_name switch.overlays (* TODO depexts *) (* TODO build / dev packages *) (* TODO constraints (os = "linux") *) let direct_dependencies (switch : OpamFile.SwitchExport.t) pkg = - let available = switch.selections.sel_installed in - let opam = opam switch pkg in - let set = filtered_formula_to_pkgs switch (OpamFile.OPAM.depends opam) in - filtered_formula_to_pkgs switch ~set (OpamFile.OPAM.depopts opam) - |> Name_set.filter (fun name -> - OpamPackage.Set.exists - (fun pkg -> pkg.OpamPackage.name = name) - available - ) - + let pkg_opam_file = opam_file switch pkg in + let set = filtered_formula_to_pkgs switch (OpamFile.OPAM.depends pkg_opam_file) in + filtered_formula_to_pkgs switch ~set (OpamFile.OPAM.depopts pkg_opam_file) let transitive_dependencies (switch : OpamFile.SwitchExport.t) pkg = let available = switch.selections.sel_installed in let rec aux pkg seen_pkgs = - let opam = opam switch pkg in + let opam = opam_file switch pkg in let set = filtered_formula_to_pkgs switch (OpamFile.OPAM.depends opam) in let set = filtered_formula_to_pkgs switch ~set (OpamFile.OPAM.depopts opam) in let transitive_set = @@ -84,6 +77,7 @@ let pp_graph ppf graph = graph.nodes let dependencies ?(transitive=false) (switch : OpamFile.SwitchExport.t) = + let available = switch.selections.sel_installed in let root_pkg = root switch in let top = root_pkg.OpamPackage.name in let graph = { top ; nodes = Name_map.empty } in @@ -96,6 +90,14 @@ let dependencies ?(transitive=false) (switch : OpamFile.SwitchExport.t) = | true -> transitive_dependencies switch x | false -> direct_dependencies switch x in + let deps = + deps + |> Name_set.filter (fun name -> + OpamPackage.Set.exists + (fun pkg -> pkg.OpamPackage.name = name) + available + ) + in let graph = add_node graph x deps in let work = Name_set.diff @@ -135,6 +137,34 @@ module Dot = struct id = None; stmt_list } + type assoc_graph = (string * (string list)) list + + let of_assoc (graph:assoc_graph) : t = + let open Odot in + let stmt_list = + graph + |> List.fold_left (fun acc (pkg, deps) -> + let stmt = + let pkg_id = Double_quoted_id pkg in + let pkg_point = Edge_node_id (pkg_id, None) in + let deps_points = + deps + |> List.map (fun pkg -> + let id = Double_quoted_id pkg in + Edge_node_id (id, None) + ) + in + let edge = pkg_point, deps_points, [] in + Stmt_edge edge + in + stmt :: acc + ) [] + in + { strict = false; (*todo test params*) + kind = Digraph; + id = None; + stmt_list } + let pp ppf dot = Format.fprintf ppf "%s" (Odot.string_of_graph dot) @@ -142,7 +172,49 @@ end module Ui_prototype = struct - let dependencies data = - failwith "todo" + let dependencies ?(transitive=true) data = + let all_direct_deps = dependencies data in + let top = all_direct_deps.top in + let top_str = OpamPackage.Name.to_string top + in + let direct_deps = + all_direct_deps.nodes + |> Name_map.find top + in + let all_transitive_deps = + dependencies ~transitive data in + let direct_deps_w_transitive_deps = + direct_deps + |> Name_set.elements + |> List.map (fun direct_dep -> + let transitive_deps = + all_transitive_deps.nodes + |> Name_map.find_opt direct_dep + |> (function + | None -> Name_set.empty + | Some v -> v) + |> Name_set.elements + |> List.map OpamPackage.Name.to_string + in + let direct_dep = OpamPackage.Name.to_string direct_dep in + direct_dep, transitive_deps + ) + in + let uniquified_deps = + direct_deps_w_transitive_deps + |> List.mapi (fun i (direct_dep, transitive_deps) -> + let unique_direct_dep = Printf.sprintf "%s_%d" direct_dep i in + let unique_transitive_deps = + transitive_deps + |> List.mapi (fun i' transitive_dep -> + Printf.sprintf "%s_%d.%d" transitive_dep i i' + ) + in + unique_direct_dep, unique_transitive_deps + ) + in + let unique_direct_deps = uniquified_deps |> List.map fst + in + (top_str, unique_direct_deps) :: uniquified_deps end From 47a4c37c7674fe27163198d2c3e0453588a90111 Mon Sep 17 00:00:00 2001 From: rand00 Date: Tue, 11 Jan 2022 13:47:59 +0100 Subject: [PATCH 07/35] WIP: Begun implementing svg UI based on scaleable idea for hover-effects + Changed cli-interface --- app/main.ml | 32 +++++---- src/dune | 2 +- src/opam_graph.ml | 164 ++++++++++++++++++++++++++++------------------ 3 files changed, 123 insertions(+), 75 deletions(-) diff --git a/app/main.ml b/app/main.ml index 85d82bf..2dd5b13 100644 --- a/app/main.ml +++ b/app/main.ml @@ -25,18 +25,28 @@ let () = Format.printf "%a" Opam_graph.pp_graph graph | "dot" -> let graph = Opam_graph.dependencies data in - let dot = Opam_graph.Dot.of_graph graph in - Format.printf "%a" Opam_graph.Dot.pp dot - | "proto_ui_transitive" -> - let transitive = true in - let graph = Opam_graph.Ui_prototype.dependencies ~transitive data in - let dot = Opam_graph.Dot.of_assoc graph in - Format.printf "%a" Opam_graph.Dot.pp dot - | "proto_ui" -> + let dot = Opam_graph.Render.Dot.of_graph graph in + Format.printf "%a" Opam_graph.Render.Dot.pp dot + | "dot_ui" -> let transitive = false in - let graph = Opam_graph.Ui_prototype.dependencies ~transitive data in - let dot = Opam_graph.Dot.of_assoc graph in - Format.printf "%a" Opam_graph.Dot.pp dot + let graph = Opam_graph.Ui.dependencies ~transitive data in + let dot = Opam_graph.Render.Dot.of_assoc graph in + Format.printf "%a" Opam_graph.Render.Dot.pp dot + | "dot_ui_transitive" -> + let transitive = true in + let graph = Opam_graph.Ui.dependencies ~transitive data in + let dot = Opam_graph.Render.Dot.of_assoc graph in + Format.printf "%a" Opam_graph.Render.Dot.pp dot + | "html_ui" -> + let transitive = false in + let graph = Opam_graph.Ui.dependencies ~transitive data in + let html = Opam_graph.Render.Html.of_assoc graph in + Format.printf "%a" Opam_graph.Render.Html.pp html + | "html_ui_transitive" -> + let transitive = true in + let graph = Opam_graph.Ui.dependencies ~transitive data in + let html = Opam_graph.Render.Html.of_assoc graph in + Format.printf "%a" Opam_graph.Render.Html.pp html | _ -> failwith "Unsupported output format" ) | _ -> diff --git a/src/dune b/src/dune index 9513e4f..dab03e0 100644 --- a/src/dune +++ b/src/dune @@ -1,6 +1,6 @@ (library (name opam_graph) (public_name opam-graph) - (libraries opam-core opam-format dot rresult) + (libraries opam-core opam-format dot rresult tyxml) (flags (:standard (-w -27-26))) ) diff --git a/src/opam_graph.ml b/src/opam_graph.ml index 3cb0b37..b297f28 100644 --- a/src/opam_graph.ml +++ b/src/opam_graph.ml @@ -108,71 +108,13 @@ let dependencies ?(transitive=false) (switch : OpamFile.SwitchExport.t) = in find_deps graph (Name_set.singleton top) -module Dot = struct - - type t = Odot.graph - - let of_graph (graph:graph) : t = - let open Odot in - let stmt_list = - Name_map.fold (fun pkg deps acc -> - let stmt = - let pkg_id = Double_quoted_id (OpamPackage.Name.to_string pkg) in - let pkg_point = Edge_node_id (pkg_id, None) in - let deps_points = - Name_set.elements deps - |> List.map (fun p -> - let id = Double_quoted_id (OpamPackage.Name.to_string p) in - Edge_node_id (id, None) - ) - in - let edge = pkg_point, deps_points, [] in - Stmt_edge edge - in - stmt :: acc - ) graph.nodes [] - in - { strict = false; (*todo test params*) - kind = Digraph; - id = None; - stmt_list } - - type assoc_graph = (string * (string list)) list +(*!Note the first entry is seen as the top node*) +type assoc_graph = (string * (string list)) list - let of_assoc (graph:assoc_graph) : t = - let open Odot in - let stmt_list = - graph - |> List.fold_left (fun acc (pkg, deps) -> - let stmt = - let pkg_id = Double_quoted_id pkg in - let pkg_point = Edge_node_id (pkg_id, None) in - let deps_points = - deps - |> List.map (fun pkg -> - let id = Double_quoted_id pkg in - Edge_node_id (id, None) - ) - in - let edge = pkg_point, deps_points, [] in - Stmt_edge edge - in - stmt :: acc - ) [] - in - { strict = false; (*todo test params*) - kind = Digraph; - id = None; - stmt_list } +module Ui = struct - let pp ppf dot = - Format.fprintf ppf "%s" (Odot.string_of_graph dot) - -end - -module Ui_prototype = struct - - let dependencies ?(transitive=true) data = + let dependencies ?(transitive=true) data : assoc_graph = + (*> todo can be made more efficient*) let all_direct_deps = dependencies data in let top = all_direct_deps.top in let top_str = OpamPackage.Name.to_string top @@ -181,6 +123,7 @@ module Ui_prototype = struct all_direct_deps.nodes |> Name_map.find top in + (*> todo can be made more efficient*) let all_transitive_deps = dependencies ~transitive data in let direct_deps_w_transitive_deps = @@ -218,3 +161,98 @@ module Ui_prototype = struct (top_str, unique_direct_deps) :: uniquified_deps end + +module Render = struct + + module Dot = struct + + type t = Odot.graph + + let of_graph (graph:graph) : t = + let open Odot in + let stmt_list = + Name_map.fold (fun pkg deps acc -> + let stmt = + let pkg_id = Double_quoted_id (OpamPackage.Name.to_string pkg) in + let pkg_point = Edge_node_id (pkg_id, None) in + let deps_points = + Name_set.elements deps + |> List.map (fun p -> + let id = Double_quoted_id (OpamPackage.Name.to_string p) in + Edge_node_id (id, None) + ) + in + let edge = pkg_point, deps_points, [] in + Stmt_edge edge + in + stmt :: acc + ) graph.nodes [] + in + { strict = false; (*todo test params*) + kind = Digraph; + id = None; + stmt_list } + + let of_assoc (graph:assoc_graph) : t = + let open Odot in + let stmt_list = + graph + |> List.fold_left (fun acc (pkg, deps) -> + let stmt = + let pkg_id = Double_quoted_id pkg in + let pkg_point = Edge_node_id (pkg_id, None) in + let deps_points = + deps + |> List.map (fun pkg -> + let id = Double_quoted_id pkg in + Edge_node_id (id, None) + ) + in + let edge = pkg_point, deps_points, [] in + Stmt_edge edge + in + stmt :: acc + ) [] + in + { strict = false; (*todo test params*) + kind = Digraph; + id = None; + stmt_list } + + let pp ppf dot = + Format.fprintf ppf "%s" (Odot.string_of_graph dot) + + end + + module Svg = struct + + type t = Tyxml_svg.doc + + let css = {| + +|} + + let of_assoc (graph:assoc_graph) : t = + failwith "todo" + + let pp ppf html = + Format.fprintf ppf "%a@." (Tyxml_svg.pp ()) html + + end + + module Html = struct + + (*goto - include css + svg, like treemap + .. also supporting separation of these so consumer can construct own html + *) + + type t = Tyxml_html.doc + + let of_assoc (graph:assoc_graph) : t = failwith "todo" + + let pp ppf html = + Format.fprintf ppf "%a@." (Tyxml_html.pp ()) html + + end + +end From 5592e146fdfc0b643d4ee48096d8b2d87085093a Mon Sep 17 00:00:00 2001 From: rand00 Date: Tue, 11 Jan 2022 15:56:18 +0100 Subject: [PATCH 08/35] Opam_graph: WIP: Implementing deps. UI: Now there is html output via CLI --- src/opam_graph.ml | 71 ++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 64 insertions(+), 7 deletions(-) diff --git a/src/opam_graph.ml b/src/opam_graph.ml index b297f28..46abfd8 100644 --- a/src/opam_graph.ml +++ b/src/opam_graph.ml @@ -228,12 +228,64 @@ module Render = struct type t = Tyxml_svg.doc + module Svg = Tyxml_svg + + (*> goto + * change svg width+height to pct again - using vw+vh for development + * svg width+height shouldn't be here for compatibility with user css? + *) let css = {| + +svg { + width : 100vw; + height : 100vh; +} |} - + + type position = { + x : float; + y : float; + } + + module Unit = struct + + let none size = size, None + + end + + (*goto pass data or preformatted string *) + let make_title = + let s = Format.asprintf "foo" in + Svg.(title (txt s)) + + let make_circle ~pos ~radius = + Svg.[ + circle ~a:[ + a_class ["node_circle"]; + a_cx @@ Unit.none pos.x; + a_cy @@ Unit.none pos.y; + a_r @@ Unit.none radius; + ] [] + ] + + let make_node ~pos ~radius = + let title = make_title in + Svg.g + ~a:[Svg.a_class ["node"]] + (title :: make_circle ~pos ~radius) + let of_assoc (graph:assoc_graph) : t = - failwith "todo" + match graph with + | [] -> Tyxml_svg.svg [] + | (top, direct_deps) :: layer2_deps -> + let top_svg = + let pos = { x = 0.5; y = 0.5 } in + let radius = 0.1 in + make_node ~pos ~radius + in + let a = [ Svg.a_viewBox (0., 0., 1., 1.) ] in + Svg.svg ~a [ top_svg ] let pp ppf html = Format.fprintf ppf "%a@." (Tyxml_svg.pp ()) html @@ -242,13 +294,18 @@ module Render = struct module Html = struct - (*goto - include css + svg, like treemap - .. also supporting separation of these so consumer can construct own html - *) + module H = Tyxml_html - type t = Tyxml_html.doc + type t = H.doc - let of_assoc (graph:assoc_graph) : t = failwith "todo" + let of_assoc (graph:assoc_graph) : t = + let svg = Svg.of_assoc graph in + H.html + (H.head + (H.title (H.txt "Dependencies")) + [H.style [H.Unsafe.data Svg.css]] + ) + (H.body [ H.svg [ svg ] ]) let pp ppf html = Format.fprintf ppf "%a@." (Tyxml_html.pp ()) html From fd0d6c3ee8dbcd3e3a4d4dadc1e7d53315bac654 Mon Sep 17 00:00:00 2001 From: rand00 Date: Wed, 12 Jan 2022 15:20:16 +0100 Subject: [PATCH 09/35] dune: Added gg --- src/dune | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/dune b/src/dune index dab03e0..126c29b 100644 --- a/src/dune +++ b/src/dune @@ -1,6 +1,6 @@ (library (name opam_graph) (public_name opam-graph) - (libraries opam-core opam-format dot rresult tyxml) + (libraries opam-core opam-format dot rresult tyxml gg) (flags (:standard (-w -27-26))) ) From a251ec04da51e2c6bdd86ad5b21f31c96389a11c Mon Sep 17 00:00:00 2001 From: rand00 Date: Wed, 12 Jan 2022 15:22:01 +0100 Subject: [PATCH 10/35] Opam_graph: UI: Visualizing direct deps in the correct flat structure for future CSS selectors --- src/opam_graph.ml | 112 +++++++++++++++++++++++++++++++++++----------- 1 file changed, 86 insertions(+), 26 deletions(-) diff --git a/src/opam_graph.ml b/src/opam_graph.ml index 46abfd8..55615a5 100644 --- a/src/opam_graph.ml +++ b/src/opam_graph.ml @@ -1,3 +1,6 @@ + +let sprintf = Printf.sprintf + module Set = OpamPackage.Set type package = OpamPackage.t @@ -108,20 +111,24 @@ let dependencies ?(transitive=false) (switch : OpamFile.SwitchExport.t) = in find_deps graph (Name_set.singleton top) -(*!Note the first entry is seen as the top node*) -type assoc_graph = (string * (string list)) list +(*!Note the first entry is seen as the root node*) +type assoc_node = { + name : string; + uniqueness_postfix : string; +} +type assoc_graph = (assoc_node * (assoc_node list)) list module Ui = struct let dependencies ?(transitive=true) data : assoc_graph = (*> todo can be made more efficient*) let all_direct_deps = dependencies data in - let top = all_direct_deps.top in - let top_str = OpamPackage.Name.to_string top + let root = all_direct_deps.top in + let root_str = OpamPackage.Name.to_string root in let direct_deps = all_direct_deps.nodes - |> Name_map.find top + |> Name_map.find root in (*> todo can be made more efficient*) let all_transitive_deps = @@ -146,19 +153,24 @@ module Ui = struct let uniquified_deps = direct_deps_w_transitive_deps |> List.mapi (fun i (direct_dep, transitive_deps) -> - let unique_direct_dep = Printf.sprintf "%s_%d" direct_dep i in - let unique_transitive_deps = + let direct_dep_node = { + name = direct_dep; + uniqueness_postfix = sprintf "%d" i; + } + and unique_transitive_deps = transitive_deps |> List.mapi (fun i' transitive_dep -> - Printf.sprintf "%s_%d.%d" transitive_dep i i' + let uniqueness_postfix = sprintf "%d.%d" i i' in + { name = transitive_dep; uniqueness_postfix } ) in - unique_direct_dep, unique_transitive_deps + direct_dep_node, unique_transitive_deps ) in - let unique_direct_deps = uniquified_deps |> List.map fst + let unique_direct_deps = uniquified_deps |> List.map fst in + let root_node = { name = root_str; uniqueness_postfix = "" } in - (top_str, unique_direct_deps) :: uniquified_deps + (root_node, unique_direct_deps) :: uniquified_deps end @@ -193,18 +205,21 @@ module Render = struct id = None; stmt_list } + let id_of_assoc_node node = + sprintf "%s_%s" node.name node.uniqueness_postfix + let of_assoc (graph:assoc_graph) : t = let open Odot in let stmt_list = graph |> List.fold_left (fun acc (pkg, deps) -> let stmt = - let pkg_id = Double_quoted_id pkg in + let pkg_id = Double_quoted_id (id_of_assoc_node pkg) in let pkg_point = Edge_node_id (pkg_id, None) in let deps_points = deps |> List.map (fun pkg -> - let id = Double_quoted_id pkg in + let id = Double_quoted_id (id_of_assoc_node pkg) in Edge_node_id (id, None) ) in @@ -255,8 +270,8 @@ svg { end (*goto pass data or preformatted string *) - let make_title = - let s = Format.asprintf "foo" in + let make_title ~text = + let s = sprintf "%s" text in Svg.(title (txt s)) let make_circle ~pos ~radius = @@ -269,23 +284,68 @@ svg { ] [] ] - let make_node ~pos ~radius = - let title = make_title in - Svg.g - ~a:[Svg.a_class ["node"]] - (title :: make_circle ~pos ~radius) + let make_node ~pos ~radius ~text ~classes = + let title = make_title ~text in + let a = [ Svg.a_class ("node" :: classes) ] in + Svg.g ~a (title :: make_circle ~pos ~radius) + let center = { x = 0.5; y = 0.5 } + + let root_radius = 0.015 + + let make_direct_deps ~deps_w_positions = + deps_w_positions |> List.map (fun ((dep, pos), layer2_deps) -> + let radius = root_radius *. 0.7 + and text = + sprintf "%s\nDependencies: %d" + dep.name (List.length layer2_deps) + and classes = [ dep.name; "direct_dep" ] in + make_node ~pos ~radius ~text ~classes + ) + + (*goto define both direct and layer2 deps here + * all nodes should be laid out in the same list + * could visualize layer2-deps as a spiral of dots + * so there is a visual order + * so they can be sorted too - e.g. by how many deps they have + *) + let make_deps (deps:assoc_graph) = + let deps_w_positions = + let open Gg in + let len_deps = List.length deps in + let diff_angle = Float.two_pi /. float len_deps in + deps |> List.mapi (fun i (dep, layer2_deps) -> + let angle = diff_angle *. float i in + let dist_center = 0.2 in + let x = cos angle *. dist_center +. center.x + and y = sin angle *. dist_center +. center.y in + ((dep, { x; y }), layer2_deps) + ) + in + let direct_deps_nodes = make_direct_deps ~deps_w_positions in + let direct_deps_edges = [] in + let layer2_deps_nodes = [] in + let layer2_deps_edges = [] + in + direct_deps_nodes @ direct_deps_edges @ + layer2_deps_nodes @ layer2_deps_edges + let of_assoc (graph:assoc_graph) : t = match graph with | [] -> Tyxml_svg.svg [] - | (top, direct_deps) :: layer2_deps -> - let top_svg = - let pos = { x = 0.5; y = 0.5 } in - let radius = 0.1 in - make_node ~pos ~radius + | (root_pkg, direct_deps) :: layer2_deps -> + let root_svg = + let pos = center + and radius = root_radius + and text = + sprintf "%s\nDirect dependencies: %d" + root_pkg.name (List.length direct_deps) + and classes = [ root_pkg.name; "root" ] in + make_node ~pos ~radius ~text ~classes in + let deps_svgs = make_deps layer2_deps in let a = [ Svg.a_viewBox (0., 0., 1., 1.) ] in - Svg.svg ~a [ top_svg ] + Svg.svg ~a (root_svg :: deps_svgs) let pp ppf html = Format.fprintf ppf "%a@." (Tyxml_svg.pp ()) html From 6f9b90eff906429c2169228d159d8a88698081b7 Mon Sep 17 00:00:00 2001 From: rand00 Date: Wed, 12 Jan 2022 15:44:05 +0100 Subject: [PATCH 11/35] Opam_graph: UI: Rendering direct-dep edges + some arbitrary styling --- src/opam_graph.ml | 42 ++++++++++++++++++++++++++++++++++-------- 1 file changed, 34 insertions(+), 8 deletions(-) diff --git a/src/opam_graph.ml b/src/opam_graph.ml index 55615a5..5a86600 100644 --- a/src/opam_graph.ml +++ b/src/opam_graph.ml @@ -254,6 +254,12 @@ module Render = struct svg { width : 100vw; height : 100vh; + background : brown; +} + +line { + stroke-width: 0.005; + stroke: bisque; } |} @@ -289,11 +295,23 @@ svg { let a = [ Svg.a_class ("node" :: classes) ] in Svg.g ~a (title :: make_circle ~pos ~radius) - let center = { x = 0.5; y = 0.5 } + let make_line ~pos0 ~pos1 = + Svg.(line ~a:[ + a_x1 @@ Unit.none pos0.x; + a_y1 @@ Unit.none pos0.y; + a_x2 @@ Unit.none pos1.x; + a_y2 @@ Unit.none pos1.y; + ]) [] + + let make_edge ~pos0 ~pos1 ~classes = + let a = [ Svg.a_class ("edge" :: classes) ] in + Svg.g ~a [ make_line ~pos0 ~pos1 ] + (*goto move up to top ? *) + let center = { x = 0.5; y = 0.5 } let root_radius = 0.015 - let make_direct_deps ~deps_w_positions = + let make_direct_deps_nodes ~deps_w_positions = deps_w_positions |> List.map (fun ((dep, pos), layer2_deps) -> let radius = root_radius *. 0.7 and text = @@ -302,7 +320,15 @@ svg { and classes = [ dep.name; "direct_dep" ] in make_node ~pos ~radius ~text ~classes ) - + + let make_direct_deps_edges ~deps_w_positions = + deps_w_positions |> List.map (fun ((dep, pos), layer2_deps) -> + let pos0 = center in + let pos1 = pos in + let classes = [ dep.name; "direct_dep" ] in + make_edge ~pos0 ~pos1 ~classes + ) + (*goto define both direct and layer2 deps here * all nodes should be laid out in the same list * could visualize layer2-deps as a spiral of dots @@ -322,13 +348,13 @@ svg { ((dep, { x; y }), layer2_deps) ) in - let direct_deps_nodes = make_direct_deps ~deps_w_positions in - let direct_deps_edges = [] in + let direct_deps_nodes = make_direct_deps_nodes ~deps_w_positions in + let direct_deps_edges = make_direct_deps_edges ~deps_w_positions in let layer2_deps_nodes = [] in let layer2_deps_edges = [] in - direct_deps_nodes @ direct_deps_edges @ - layer2_deps_nodes @ layer2_deps_edges + direct_deps_edges @ direct_deps_nodes @ + layer2_deps_edges @ layer2_deps_nodes let of_assoc (graph:assoc_graph) : t = match graph with @@ -345,7 +371,7 @@ svg { in let deps_svgs = make_deps layer2_deps in let a = [ Svg.a_viewBox (0., 0., 1., 1.) ] in - Svg.svg ~a (root_svg :: deps_svgs) + Svg.svg ~a (deps_svgs @ [ root_svg ]) let pp ppf html = Format.fprintf ppf "%a@." (Tyxml_svg.pp ()) html From c985ecc156e27f383e4f29984bd919f0887b7fe2 Mon Sep 17 00:00:00 2001 From: rand00 Date: Wed, 12 Jan 2022 15:59:22 +0100 Subject: [PATCH 12/35] Opam_graph: UI: More informative info box on direct deps --- src/opam_graph.ml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/opam_graph.ml b/src/opam_graph.ml index 5a86600..b567c2d 100644 --- a/src/opam_graph.ml +++ b/src/opam_graph.ml @@ -315,7 +315,8 @@ line { deps_w_positions |> List.map (fun ((dep, pos), layer2_deps) -> let radius = root_radius *. 0.7 and text = - sprintf "%s\nDependencies: %d" + sprintf "Direct dependency: %s\nDependencies: %d" + (*< goto choose between transitive/direct*) dep.name (List.length layer2_deps) and classes = [ dep.name; "direct_dep" ] in make_node ~pos ~radius ~text ~classes From 99a90b91ae06c25869b580156efafbeef1823557 Mon Sep 17 00:00:00 2001 From: rand00 Date: Wed, 12 Jan 2022 16:34:47 +0100 Subject: [PATCH 13/35] Opam_graph: UI: Rendering layer2-deps in spirals --- src/opam_graph.ml | 30 +++++++++++++++++++++++++++++- 1 file changed, 29 insertions(+), 1 deletion(-) diff --git a/src/opam_graph.ml b/src/opam_graph.ml index b567c2d..8e9eb77 100644 --- a/src/opam_graph.ml +++ b/src/opam_graph.ml @@ -330,6 +330,34 @@ line { make_edge ~pos0 ~pos1 ~classes ) + let make_layer2_deps_nodes ~deps_w_positions = + let open Gg in + deps_w_positions |> List.concat_map + (fun ((_, 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 + V2.(1.5 * (direct_dep_pos - center) + center) + in + let dot_radius = root_radius *. 0.2 + in + layer2_deps |> List.mapi (fun i' layer2_dep -> + let i' = float i' in + let angle_diff = Float.two_pi /. (20. -. i' *. 0.3) in + let pos_radius = i' *. 0.002 in + let pos_angle = i' *. angle_diff in + let pos_rel = + V2.v pos_radius pos_angle + |> V2.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 classes = [ layer2_dep.name; "layer2_dep" ] in + make_node ~pos ~radius:dot_radius ~text ~classes + ) + ) + (*goto define both direct and layer2 deps here * all nodes should be laid out in the same list * could visualize layer2-deps as a spiral of dots @@ -351,7 +379,7 @@ line { in let direct_deps_nodes = make_direct_deps_nodes ~deps_w_positions in let direct_deps_edges = make_direct_deps_edges ~deps_w_positions in - let layer2_deps_nodes = [] in + let layer2_deps_nodes = make_layer2_deps_nodes ~deps_w_positions in let layer2_deps_edges = [] in direct_deps_edges @ direct_deps_nodes @ From ca489c91d2143a75b4b74695905dbccb9c178923 Mon Sep 17 00:00:00 2001 From: rand00 Date: Wed, 12 Jan 2022 17:28:10 +0100 Subject: [PATCH 14/35] Opam_graph: UI: Rendering layer2-deps 2 layers of spirals to exploit area better --- src/opam_graph.ml | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/src/opam_graph.ml b/src/opam_graph.ml index 8e9eb77..2135aa2 100644 --- a/src/opam_graph.ml +++ b/src/opam_graph.ml @@ -332,19 +332,25 @@ line { let make_layer2_deps_nodes ~deps_w_positions = let open Gg in - deps_w_positions |> List.concat_map - (fun ((_, direct_dep_pos), layer2_deps) -> + deps_w_positions |> List.mapi + (fun i ((_, 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 - V2.(1.5 * (direct_dep_pos - center) + center) + let mult = + if i mod 2 = 0 then + 2.14 + else + 1.5 + in + V2.(mult * (direct_dep_pos - center) + center) in let dot_radius = root_radius *. 0.2 in layer2_deps |> List.mapi (fun i' layer2_dep -> - let i' = float i' in - let angle_diff = Float.two_pi /. (20. -. i' *. 0.3) in - let pos_radius = i' *. 0.002 in + let i' = float i' +. 5.5 in + let pos_radius = sqrt i' *. 0.010 -. 0.019 in + let angle_diff = sqrt i' *. Float.two_pi *. 0.05 in let pos_angle = i' *. angle_diff in let pos_rel = V2.v pos_radius pos_angle @@ -357,6 +363,7 @@ line { make_node ~pos ~radius:dot_radius ~text ~classes ) ) + |> List.flatten (*goto define both direct and layer2 deps here * all nodes should be laid out in the same list From dae09527d2a48c5187a925835ffba30664a66cc4 Mon Sep 17 00:00:00 2001 From: rand00 Date: Wed, 12 Jan 2022 19:38:11 +0100 Subject: [PATCH 15/35] Opam_graph: UI: Implemented radial-gradient bg behind layer2 deps blobs --- src/opam_graph.ml | 66 +++++++++++++++++++++++++++++++++++------------ 1 file changed, 50 insertions(+), 16 deletions(-) diff --git a/src/opam_graph.ml b/src/opam_graph.ml index 2135aa2..ec5def9 100644 --- a/src/opam_graph.ml +++ b/src/opam_graph.ml @@ -261,8 +261,13 @@ line { stroke-width: 0.005; stroke: bisque; } + +.layer2_deps_bg { + fill: url(#gradient_01); +} |} + (* a_fill @@ `Color ("url(#gradient_01)", None); *) type position = { x : float; @@ -347,21 +352,32 @@ line { in let dot_radius = root_radius *. 0.2 in - layer2_deps |> List.mapi (fun i' layer2_dep -> - let i' = float i' +. 5.5 in - let pos_radius = sqrt i' *. 0.010 -. 0.019 in - let angle_diff = sqrt i' *. Float.two_pi *. 0.05 in - let pos_angle = i' *. angle_diff in - let pos_rel = - V2.v pos_radius pos_angle - |> V2.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 classes = [ layer2_dep.name; "layer2_dep" ] in - make_node ~pos ~radius:dot_radius ~text ~classes - ) + let nodes = + layer2_deps |> List.mapi (fun i' layer2_dep -> + let i' = float i' +. 5.5 in + let pos_radius = sqrt i' *. 0.012 -. 0.024 in + let angle_diff = sqrt i' *. Float.two_pi *. 0.055 in + let pos_angle = i' *. angle_diff in + let pos_rel = + V2.v pos_radius pos_angle + |> V2.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 classes = [ layer2_dep.name; "layer2_dep" ] in + make_node ~pos ~radius:dot_radius ~text ~classes + ) + in + let bg = + let pos = + { x = V2.x layer2_deps_center; y = V2.y layer2_deps_center } + and radius = float (List.length layer2_deps) *. 0.003 + and text = "" + and classes = [ "layer2_deps_bg" ] in + make_node ~pos ~radius ~text ~classes + in + bg :: nodes ) |> List.flatten @@ -407,7 +423,25 @@ line { in let deps_svgs = make_deps layer2_deps in let a = [ Svg.a_viewBox (0., 0., 1., 1.) ] in - Svg.svg ~a (deps_svgs @ [ root_svg ]) + let svg_defs =Svg.[ defs [ + radialGradient ~a:[ + a_id "gradient_01"; + a_cx @@ Unit.none 0.5; + a_cy @@ Unit.none 0.5; + a_r @@ Unit.none 0.5; + ] [ + stop ~a:[ + a_offset @@ `Percentage 0.; + a_stop_color "bisque" + ] []; + stop ~a:[ + a_offset @@ `Percentage 100.; + a_stop_color "bisque"; a_stop_opacity 0. + ] [] + ] + ]] + in + Svg.svg ~a (svg_defs @ deps_svgs @ [ root_svg ]) let pp ppf html = Format.fprintf ppf "%a@." (Tyxml_svg.pp ()) html From 167b657a2f7be03e01c918be9b2f26a4269f2f08 Mon Sep 17 00:00:00 2001 From: rand00 Date: Thu, 13 Jan 2022 11:50:27 +0100 Subject: [PATCH 16/35] Opam_graph: UI: Adding edges to layer2 deps blobs - beautiful visual bug --- src/opam_graph.ml | 41 +++++++++++++++++++---------------------- 1 file changed, 19 insertions(+), 22 deletions(-) diff --git a/src/opam_graph.ml b/src/opam_graph.ml index ec5def9..90d2f13 100644 --- a/src/opam_graph.ml +++ b/src/opam_graph.ml @@ -254,11 +254,11 @@ module Render = struct svg { width : 100vw; height : 100vh; - background : brown; + background : slategrey; } line { - stroke-width: 0.005; + stroke-width: 0.004; stroke: bisque; } @@ -274,6 +274,9 @@ line { y : float; } + let center = { x = 0.5; y = 0.5 } + let root_radius = 0.015 + module Unit = struct let none size = size, None @@ -312,10 +315,6 @@ line { let a = [ Svg.a_class ("edge" :: classes) ] in Svg.g ~a [ make_line ~pos0 ~pos1 ] - (*goto move up to top ? *) - let center = { x = 0.5; y = 0.5 } - let root_radius = 0.015 - let make_direct_deps_nodes ~deps_w_positions = deps_w_positions |> List.map (fun ((dep, pos), layer2_deps) -> let radius = root_radius *. 0.7 @@ -335,18 +334,14 @@ line { make_edge ~pos0 ~pos1 ~classes ) - let make_layer2_deps_nodes ~deps_w_positions = + let make_layer2_deps ~deps_w_positions = let open Gg in deps_w_positions |> List.mapi (fun i ((_, 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 - let mult = - if i mod 2 = 0 then - 2.14 - else - 1.5 + let mult = if i mod 2 = 0 then 2.14 else 1.5 in V2.(mult * (direct_dep_pos - center) + center) in @@ -358,10 +353,7 @@ line { let pos_radius = sqrt i' *. 0.012 -. 0.024 in let angle_diff = sqrt i' *. Float.two_pi *. 0.055 in let pos_angle = i' *. angle_diff in - let pos_rel = - V2.v pos_radius pos_angle - |> V2.of_polar - in + 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 @@ -374,10 +366,17 @@ line { { x = V2.x layer2_deps_center; y = V2.y layer2_deps_center } and radius = float (List.length layer2_deps) *. 0.003 and text = "" - and classes = [ "layer2_deps_bg" ] in + and classes = [ "layer2_deps"; "bg" ] in make_node ~pos ~radius ~text ~classes in - bg :: nodes + let edge = + let pos0 = direct_dep_pos in + let pos1 = + { x = V2.x layer2_deps_center; y = V2.y layer2_deps_center } in + let classes = [ "layer2_deps" ] in + make_edge ~pos0 ~pos1 ~classes + in + edge :: bg :: nodes ) |> List.flatten @@ -402,11 +401,9 @@ line { in let direct_deps_nodes = make_direct_deps_nodes ~deps_w_positions in let direct_deps_edges = make_direct_deps_edges ~deps_w_positions in - let layer2_deps_nodes = make_layer2_deps_nodes ~deps_w_positions in - let layer2_deps_edges = [] + let layer2_deps = make_layer2_deps ~deps_w_positions in - direct_deps_edges @ direct_deps_nodes @ - layer2_deps_edges @ layer2_deps_nodes + direct_deps_edges @ direct_deps_nodes @ layer2_deps let of_assoc (graph:assoc_graph) : t = match graph with From f245509c808a518decc5b679a47e29c11eae2f16 Mon Sep 17 00:00:00 2001 From: rand00 Date: Thu, 13 Jan 2022 12:02:32 +0100 Subject: [PATCH 17/35] Opam_graph: UI: Styling: Alternative layer2 deps bg --- src/opam_graph.ml | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/src/opam_graph.ml b/src/opam_graph.ml index 90d2f13..a343490 100644 --- a/src/opam_graph.ml +++ b/src/opam_graph.ml @@ -262,12 +262,18 @@ line { stroke: bisque; } -.layer2_deps_bg { - fill: url(#gradient_01); +.layer2_deps.bg { + fill: ghostwhite; } |} - (* a_fill @@ `Color ("url(#gradient_01)", None); *) + + (*< Note the '.layer2_deps.bg' selector... + https://steveliles.github.io/a_multi_class_union_css_selector.html*) + (* .layer2_deps.bg fills: + OCaml: a_fill @@ `Color ("url(#gradient_01)", None); + CSS: fill: url(#gradient_01); + *) type position = { x : float; From 48a65104095a036478515d642680150896f92c5e Mon Sep 17 00:00:00 2001 From: rand00 Date: Thu, 13 Jan 2022 12:06:03 +0100 Subject: [PATCH 18/35] Opam_graph: UI: New radius calculation for layer2 deps bg that is a tighter fit --- 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 a343490..ad02f64 100644 --- a/src/opam_graph.ml +++ b/src/opam_graph.ml @@ -370,7 +370,7 @@ line { let bg = let pos = { x = V2.x layer2_deps_center; y = V2.y layer2_deps_center } - and radius = float (List.length layer2_deps) *. 0.003 + and radius = sqrt (float (List.length layer2_deps) +. 1.) *. 0.009 and text = "" and classes = [ "layer2_deps"; "bg" ] in make_node ~pos ~radius ~text ~classes From f9d76de12de1077bd21dc8fada1fc704be2db86e Mon Sep 17 00:00:00 2001 From: rand00 Date: Thu, 13 Jan 2022 17:04:31 +0100 Subject: [PATCH 19/35] Opam_graph: UI: Playing with solution to SVG paint-order vs CSS sibling-selector order --- src/opam_graph.ml | 34 ++++++++++++++++++++++++++-------- 1 file changed, 26 insertions(+), 8 deletions(-) diff --git a/src/opam_graph.ml b/src/opam_graph.ml index ad02f64..912e981 100644 --- a/src/opam_graph.ml +++ b/src/opam_graph.ml @@ -265,9 +265,24 @@ line { .layer2_deps.bg { fill: ghostwhite; } + +.direct_dep.node:hover { + transform-origin: center; + transform: scale(2); +} + +.root:hover { + transform-origin: center; + transform: scale(2); + stroke-width: 0.009 !important; +} |} + (* disabled CSS + + *) + (*< Note the '.layer2_deps.bg' selector... https://steveliles.github.io/a_multi_class_union_css_selector.html*) (* .layer2_deps.bg fills: @@ -333,9 +348,18 @@ line { ) let make_direct_deps_edges ~deps_w_positions = + let open Gg in deps_w_positions |> List.map (fun ((dep, pos), layer2_deps) -> - let pos0 = center in let pos1 = pos in + let pos0 = + let center = V2.v center.x center.y in + let pos1 = V2.v pos1.x pos1.y in + let pos1_rel = V2.(pos1 - center) in + let pos1_rel_angle = V2.angle pos1_rel in + let pos0_rel = V2.(v root_radius pos1_rel_angle |> of_polar) in + let pos0 = V2.(pos0_rel + center) in + { x = V2.x pos0; y = V2.y pos0 } + in let classes = [ dep.name; "direct_dep" ] in make_edge ~pos0 ~pos1 ~classes ) @@ -386,12 +410,6 @@ line { ) |> List.flatten - (*goto define both direct and layer2 deps here - * all nodes should be laid out in the same list - * could visualize layer2-deps as a spiral of dots - * so there is a visual order - * so they can be sorted too - e.g. by how many deps they have - *) let make_deps (deps:assoc_graph) = let deps_w_positions = let open Gg in @@ -444,7 +462,7 @@ line { ] ]] in - Svg.svg ~a (svg_defs @ deps_svgs @ [ root_svg ]) + Svg.svg ~a (svg_defs @ (root_svg :: deps_svgs)) let pp ppf html = Format.fprintf ppf "%a@." (Tyxml_svg.pp ()) html From 2c81dd1319e1cc45df7a46149d658da262ad6844 Mon Sep 17 00:00:00 2001 From: rand00 Date: Thu, 13 Jan 2022 17:30:51 +0100 Subject: [PATCH 20/35] Opam_graph: UI: Hack to set transform-origins on svg-elements --- src/opam_graph.ml | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/src/opam_graph.ml b/src/opam_graph.ml index 912e981..984fe37 100644 --- a/src/opam_graph.ml +++ b/src/opam_graph.ml @@ -271,16 +271,15 @@ line { transform: scale(2); } -.root:hover { - transform-origin: center; +.root:hover ~ .node { transform: scale(2); - stroke-width: 0.009 !important; } |} (* disabled CSS - + transform-origin: center; + stroke-width: 0.009 !important; *) (*< Note the '.layer2_deps.bg' selector... @@ -321,7 +320,11 @@ line { let make_node ~pos ~radius ~text ~classes = let title = make_title ~text in - let a = [ Svg.a_class ("node" :: classes) ] in + let a_transform_origin = Svg.Unsafe.string_attrib "transform-origin" in + let a = Svg.[ + a_class ("node" :: classes); + a_transform_origin @@ sprintf "%f %f" pos.x pos.y; + ] in Svg.g ~a (title :: make_circle ~pos ~radius) let make_line ~pos0 ~pos1 = @@ -352,6 +355,7 @@ line { deps_w_positions |> List.map (fun ((dep, pos), layer2_deps) -> let pos1 = pos in let pos0 = + (*> Note: Need this because of mix of CSS selectors and SVG paint order*) let center = V2.v center.x center.y in let pos1 = V2.v pos1.x pos1.y in let pos1_rel = V2.(pos1 - center) in From ad5501075242244fc30118968a70a0fb08311b07 Mon Sep 17 00:00:00 2001 From: rand00 Date: Thu, 13 Jan 2022 17:40:09 +0100 Subject: [PATCH 21/35] Opam_graph: UI: Removed old transform-origin override + todo-node for generating CSS --- src/opam_graph.ml | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/opam_graph.ml b/src/opam_graph.ml index 984fe37..17a98ea 100644 --- a/src/opam_graph.ml +++ b/src/opam_graph.ml @@ -267,17 +267,22 @@ line { } .direct_dep.node:hover { - transform-origin: center; transform: scale(2); } .root:hover ~ .node { - transform: scale(2); + transform: scale(1.1); } |} (* disabled CSS +(*> goto generate this and select unique direct-dep pkg equal to self*) +.direct_dep.edge:hover ~ .direct_dep.node { + transform: scale(2); +} + + transform-origin: center; stroke-width: 0.009 !important; *) @@ -320,6 +325,7 @@ line { let make_node ~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 a = Svg.[ a_class ("node" :: classes); From 9623303f9f936e8e3f2d8f891a46e086989681d2 Mon Sep 17 00:00:00 2001 From: rand00 Date: Fri, 14 Jan 2022 11:07:32 +0100 Subject: [PATCH 22/35] Opam_graph: UI: Generating css to make hove on direct-dep edges scale direct-dep --- src/opam_graph.ml | 85 ++++++++++++++++++++++++++++++----------------- 1 file changed, 55 insertions(+), 30 deletions(-) diff --git a/src/opam_graph.ml b/src/opam_graph.ml index 17a98ea..f9aa109 100644 --- a/src/opam_graph.ml +++ b/src/opam_graph.ml @@ -243,13 +243,18 @@ module Render = struct type t = Tyxml_svg.doc + type output = { + svg : t; + css : string; + } + module Svg = Tyxml_svg (*> goto * change svg width+height to pct again - using vw+vh for development * svg width+height shouldn't be here for compatibility with user css? *) - let css = {| + let initial_css = {| svg { width : 100vw; @@ -282,10 +287,11 @@ line { transform: scale(2); } - transform-origin: center; stroke-width: 0.009 !important; *) + + let add_css c c' = String.concat "\n" [ c; c' ] (*< Note the '.layer2_deps.bg' selector... https://steveliles.github.io/a_multi_class_union_css_selector.html*) @@ -356,9 +362,15 @@ line { make_node ~pos ~radius ~text ~classes ) + let make_direct_dep_edge_css dep = sprintf {| +.direct_dep.edge.%s:hover ~ .direct_dep.node.%s { + transform: scale(2); +} +|} dep dep + let make_direct_deps_edges ~deps_w_positions = let open Gg in - deps_w_positions |> List.map (fun ((dep, pos), layer2_deps) -> + let svg = deps_w_positions |> List.map (fun ((dep, pos), layer2_deps) -> let pos1 = pos in let pos0 = (*> Note: Need this because of mix of CSS selectors and SVG paint order*) @@ -372,7 +384,15 @@ line { in let classes = [ dep.name; "direct_dep" ] in make_edge ~pos0 ~pos1 ~classes - ) + ) in + let css = + deps_w_positions + |> List.fold_left (fun acc_css ((dep, _), _) -> + let css = make_direct_dep_edge_css dep.name in + add_css acc_css css + ) "" + in + svg, css let make_layer2_deps ~deps_w_positions = let open Gg in @@ -433,15 +453,36 @@ line { ((dep, { x; y }), layer2_deps) ) in + let direct_deps_edges, direct_deps_edges_css = + make_direct_deps_edges ~deps_w_positions in let direct_deps_nodes = make_direct_deps_nodes ~deps_w_positions in - let direct_deps_edges = make_direct_deps_edges ~deps_w_positions in let layer2_deps = make_layer2_deps ~deps_w_positions in - direct_deps_edges @ direct_deps_nodes @ layer2_deps + let svg = direct_deps_edges @ direct_deps_nodes @ layer2_deps in + let css = direct_deps_edges_css in + svg, css - let of_assoc (graph:assoc_graph) : t = + let svg_defs = Svg.[ defs [ + radialGradient ~a:[ + a_id "gradient_01"; + a_cx @@ Unit.none 0.5; + a_cy @@ Unit.none 0.5; + a_r @@ Unit.none 0.5; + ] [ + stop ~a:[ + a_offset @@ `Percentage 0.; + a_stop_color "bisque" + ] []; + stop ~a:[ + a_offset @@ `Percentage 100.; + a_stop_color "bisque"; a_stop_opacity 0. + ] [] + ] + ]] + + let of_assoc (graph:assoc_graph) : output = match graph with - | [] -> Tyxml_svg.svg [] + | [] -> { svg = Tyxml_svg.svg []; css = "" } | (root_pkg, direct_deps) :: layer2_deps -> let root_svg = let pos = center @@ -452,27 +493,11 @@ line { and classes = [ root_pkg.name; "root" ] in make_node ~pos ~radius ~text ~classes in - let deps_svgs = make_deps layer2_deps in + let deps_svgs, deps_css = make_deps layer2_deps in let a = [ Svg.a_viewBox (0., 0., 1., 1.) ] in - let svg_defs =Svg.[ defs [ - radialGradient ~a:[ - a_id "gradient_01"; - a_cx @@ Unit.none 0.5; - a_cy @@ Unit.none 0.5; - a_r @@ Unit.none 0.5; - ] [ - stop ~a:[ - a_offset @@ `Percentage 0.; - a_stop_color "bisque" - ] []; - stop ~a:[ - a_offset @@ `Percentage 100.; - a_stop_color "bisque"; a_stop_opacity 0. - ] [] - ] - ]] - in - Svg.svg ~a (svg_defs @ (root_svg :: deps_svgs)) + let svg = Svg.svg ~a (svg_defs @ (root_svg :: deps_svgs)) in + let css = add_css initial_css deps_css in + { svg; css } let pp ppf html = Format.fprintf ppf "%a@." (Tyxml_svg.pp ()) html @@ -490,9 +515,9 @@ line { H.html (H.head (H.title (H.txt "Dependencies")) - [H.style [H.Unsafe.data Svg.css]] + [H.style [H.Unsafe.data svg.css]] ) - (H.body [ H.svg [ svg ] ]) + (H.body [ H.svg [ svg.svg ] ]) let pp ppf html = Format.fprintf ppf "%a@." (Tyxml_html.pp ()) html From 70698c9b661496f4abc68c8dcae794d587f44847 Mon Sep 17 00:00:00 2001 From: rand00 Date: Fri, 14 Jan 2022 19:23:36 +0100 Subject: [PATCH 23/35] Opam_graph: UI: Implemented shared-dependencies marking on hover --- src/opam_graph.ml | 110 ++++++++++++++++++++++++++++++++-------------- 1 file changed, 76 insertions(+), 34 deletions(-) diff --git a/src/opam_graph.ml b/src/opam_graph.ml index f9aa109..b68bad6 100644 --- a/src/opam_graph.ml +++ b/src/opam_graph.ml @@ -1,19 +1,19 @@ let sprintf = Printf.sprintf -module Set = OpamPackage.Set +module OSet = OpamPackage.Set type package = OpamPackage.t let packages (switch : OpamFile.SwitchExport.t) = - assert (Set.cardinal switch.selections.sel_pinned = 0); - assert (Set.cardinal switch.selections.sel_compiler = 0); - assert (Set.subset switch.selections.sel_roots switch.selections.sel_installed); + assert (OSet.cardinal switch.selections.sel_pinned = 0); + assert (OSet.cardinal switch.selections.sel_compiler = 0); + assert (OSet.subset switch.selections.sel_roots switch.selections.sel_installed); switch.selections.sel_installed let root (switch : OpamFile.SwitchExport.t) = - assert (Set.cardinal switch.selections.sel_roots = 1); - Set.choose switch.selections.sel_roots + assert (OSet.cardinal switch.selections.sel_roots = 1); + OSet.choose switch.selections.sel_roots module Name_set = OpamPackage.Name.Set @@ -268,30 +268,25 @@ line { } .layer2_deps.bg { - fill: ghostwhite; + fill: bisque; } .direct_dep.node:hover { transform: scale(2); } -.root:hover ~ .node { - transform: scale(1.1); -} - |} (* disabled CSS -(*> goto generate this and select unique direct-dep pkg equal to self*) -.direct_dep.edge:hover ~ .direct_dep.node { - transform: scale(2); +.root:hover ~ .node { + transform: scale(1.1); } transform-origin: center; stroke-width: 0.009 !important; *) - let add_css c c' = String.concat "\n" [ c; c' ] + let merge_css cs = String.concat "\n" cs (*< Note the '.layer2_deps.bg' selector... https://steveliles.github.io/a_multi_class_union_css_selector.html*) @@ -314,7 +309,6 @@ line { end - (*goto pass data or preformatted string *) let make_title ~text = let s = sprintf "%s" text in Svg.(title (txt s)) @@ -347,17 +341,19 @@ line { a_y2 @@ Unit.none pos1.y; ]) [] - let make_edge ~pos0 ~pos1 ~classes = + let make_edge ~pos0 ~pos1 ~text ~classes = let a = [ Svg.a_class ("edge" :: classes) ] in - Svg.g ~a [ make_line ~pos0 ~pos1 ] - + 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_deps_nodes ~deps_w_positions = deps_w_positions |> List.map (fun ((dep, pos), layer2_deps) -> let radius = root_radius *. 0.7 - and text = - sprintf "Direct dependency: %s\nDependencies: %d" - (*< goto choose between transitive/direct*) - dep.name (List.length layer2_deps) + and text = make_direct_dep_text dep ~layer2_deps and classes = [ dep.name; "direct_dep" ] in make_node ~pos ~radius ~text ~classes ) @@ -366,7 +362,14 @@ line { .direct_dep.edge.%s:hover ~ .direct_dep.node.%s { transform: scale(2); } -|} dep dep +.direct_dep.edge.%s:hover ~ .layer2_deps.bg.%s { + fill: dimgrey; +} +.direct_dep.node.%s:hover ~ .layer2_deps.bg.%s { + fill: dimgrey; +} +|} dep dep dep dep dep dep + (*< goto move generation of node-css to some other place*) let make_direct_deps_edges ~deps_w_positions = let open Gg in @@ -382,14 +385,15 @@ line { let pos0 = V2.(pos0_rel + center) in { x = V2.x pos0; y = V2.y pos0 } in + let text = make_direct_dep_text dep ~layer2_deps in let classes = [ dep.name; "direct_dep" ] in - make_edge ~pos0 ~pos1 ~classes + make_edge ~pos0 ~pos1 ~text ~classes ) in let css = deps_w_positions |> List.fold_left (fun acc_css ((dep, _), _) -> let css = make_direct_dep_edge_css dep.name in - add_css acc_css css + merge_css [ acc_css; css ] ) "" in svg, css @@ -397,7 +401,7 @@ line { let make_layer2_deps ~deps_w_positions = let open Gg in deps_w_positions |> List.mapi - (fun i ((_, 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 @@ -426,20 +430,57 @@ line { { x = V2.x layer2_deps_center; y = V2.y layer2_deps_center } and radius = sqrt (float (List.length layer2_deps) +. 1.) *. 0.009 and text = "" - and classes = [ "layer2_deps"; "bg" ] in + and classes = [ "layer2_deps"; "bg"; dep.name ] in make_node ~pos ~radius ~text ~classes in let edge = let pos0 = direct_dep_pos in let pos1 = { x = V2.x layer2_deps_center; y = V2.y layer2_deps_center } in + let text = "" in let classes = [ "layer2_deps" ] in - make_edge ~pos0 ~pos1 ~classes + make_edge ~pos0 ~pos1 ~text ~classes in edge :: bg :: nodes ) |> List.flatten + let make_shared_deps_css_aux ~dep ~shared_deps = + shared_deps |> Seq.map (fun shared_dep -> + sprintf {| +.direct_dep.%s:hover ~ .node.layer2_dep.%s { + fill: hotpink; +} + |} dep.name shared_dep + ) + |> List.of_seq + |> merge_css + + let make_shared_deps_css ~deps_w_positions = + let module SSet = Set.Make(String) in + let sset_of_deps deps = + deps + |> List.map (fun dep -> dep.name) + |> SSet.of_list + in + let layer2_deps_sets = + deps_w_positions |> List.map (fun (_, layer2_deps) -> + layer2_deps |> sset_of_deps + ) + in + deps_w_positions |> List.map (fun ((dep, _), layer2_deps) -> + let layer2_deps = sset_of_deps layer2_deps in + let shared_deps = + layer2_deps_sets + |> List.fold_left (fun acc layer2_deps' -> + SSet.(union acc (inter layer2_deps layer2_deps')) + ) SSet.empty + |> SSet.to_seq + in + make_shared_deps_css_aux ~dep ~shared_deps + ) + |> merge_css + let make_deps (deps:assoc_graph) = let deps_w_positions = let open Gg in @@ -454,12 +495,13 @@ line { ) in let direct_deps_edges, direct_deps_edges_css = - make_direct_deps_edges ~deps_w_positions in - let direct_deps_nodes = make_direct_deps_nodes ~deps_w_positions in - let layer2_deps = make_layer2_deps ~deps_w_positions + make_direct_deps_edges ~deps_w_positions + and direct_deps_nodes = make_direct_deps_nodes ~deps_w_positions + and layer2_deps = make_layer2_deps ~deps_w_positions + and shared_deps_css = make_shared_deps_css ~deps_w_positions in let svg = direct_deps_edges @ direct_deps_nodes @ layer2_deps in - let css = direct_deps_edges_css in + let css = merge_css [ direct_deps_edges_css; shared_deps_css ] in svg, css let svg_defs = Svg.[ defs [ @@ -496,7 +538,7 @@ line { let deps_svgs, deps_css = make_deps layer2_deps in let a = [ Svg.a_viewBox (0., 0., 1., 1.) ] in let svg = Svg.svg ~a (svg_defs @ (root_svg :: deps_svgs)) in - let css = add_css initial_css deps_css in + let css = merge_css [ initial_css; deps_css ] in { svg; css } let pp ppf html = From 7c21692e2d64fb7a1a751c63487ebb594b69d974 Mon Sep 17 00:00:00 2001 From: rand00 Date: Mon, 17 Jan 2022 16:15:05 +0100 Subject: [PATCH 24/35] Opam_graph: UI: Implemented much better hitboxes for direct deps --- src/opam_graph.ml | 86 +++++++++++++++++++++++++++++++++++++---------- 1 file changed, 69 insertions(+), 17 deletions(-) diff --git a/src/opam_graph.ml b/src/opam_graph.ml index b68bad6..e5add35 100644 --- a/src/opam_graph.ml +++ b/src/opam_graph.ml @@ -370,25 +370,77 @@ line { } |} dep dep dep dep dep dep (*< goto move generation of node-css to some other place*) + + let make_triangle ~top ~left ~right = + let a = Svg.[ + a_points [ + top.x, top.y; + left.x, left.y; + right.x, right.y; + ]; + a_fill @@ `Color ("rgba(0,0,0,0)", None); (*goto control with css*) + (* a_stroke @@ `Color ("black", None); + * a_stroke_width @@ Unit.none 0.002; *) + ] in + Svg.polygon ~a [] + + let make_hitbox_direct_dep_edge ~pos0 ~pos1 ~n_edges ~text ~classes = + let a = [ Svg.a_class ("edge" :: "hitbox" :: classes) ] in + let title = make_title ~text in + let left, right = + let open Gg in + let n_edges = float (max 1 n_edges) in + let diff_angle = Float.two_pi /. n_edges in + let pos0, pos1 = V2.(v pos0.x pos0.y, v pos1.x pos1.y) in + let center = V2.v center.x center.y in + let pos1_rel = V2.(pos1 - center) in + let height_triangle = + let radius_pos1_rel, _ = V2.(to_polar pos1_rel |> to_tuple) in + radius_pos1_rel *. 1.2 in + let bottom_width = + if diff_angle < Float.pi_div_2 then + sin diff_angle *. height_triangle (*Note: Scaling sin by radius*) + else + height_triangle + in + let normal_pos1 = V2.(ortho pos1_rel / norm pos1_rel) in + let normal'_pos1 = V2.(-1. * normal_pos1) in + let right_leg = V2.((0.5 *. bottom_width) * normal_pos1) in + let left_leg = V2.((0.5 *. bottom_width) * normal'_pos1) in + let pos1_unit = V2.(pos1_rel / norm pos1_rel) in + let pos1_extended = V2.(height_triangle * pos1_unit + center) in + let right = V2.(right_leg + pos1_extended) + and left = V2.(left_leg + pos1_extended) in + { x = V2.x left; y = V2.y left }, { x = V2.x right; y = V2.y right } + in + Svg.g ~a [ title; make_triangle ~top:pos0 ~left ~right ] let make_direct_deps_edges ~deps_w_positions = let open Gg in - let svg = deps_w_positions |> List.map (fun ((dep, pos), layer2_deps) -> - let pos1 = pos in - let pos0 = - (*> Note: Need this because of mix of CSS selectors and SVG paint order*) - let center = V2.v center.x center.y in - let pos1 = V2.v pos1.x pos1.y in - let pos1_rel = V2.(pos1 - center) in - let pos1_rel_angle = V2.angle pos1_rel in - let pos0_rel = V2.(v root_radius pos1_rel_angle |> of_polar) in - let pos0 = V2.(pos0_rel + center) in - { x = V2.x pos0; y = V2.y pos0 } - in - let text = make_direct_dep_text dep ~layer2_deps in - let classes = [ dep.name; "direct_dep" ] in - make_edge ~pos0 ~pos1 ~text ~classes - ) in + let n_edges = deps_w_positions |> List.length in + let svg = + deps_w_positions |> List.concat_map (fun ((dep, pos), layer2_deps) -> + let pos1 = pos in + let pos0, pos0_angle = + (*> Note: Need this because of mix of CSS selectors and SVG paint order*) + let center = V2.v center.x center.y in + let pos1 = V2.v pos1.x pos1.y in + let pos1_rel = V2.(pos1 - center) in + let pos1_rel_angle = V2.angle pos1_rel in + let pos0_rel = V2.(v root_radius pos1_rel_angle |> of_polar) in + 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 classes = [ dep.name; "direct_dep" ] in + let visual_svg = make_edge ~pos0 ~pos1 ~text ~classes in + let hitbox_svg = + make_hitbox_direct_dep_edge + ~pos0 ~pos1 ~n_edges ~text ~classes + in + [ visual_svg; hitbox_svg ] + ) + in let css = deps_w_positions |> List.fold_left (fun acc_css ((dep, _), _) -> @@ -417,7 +469,7 @@ line { let pos_radius = sqrt i' *. 0.012 -. 0.024 in let angle_diff = sqrt i' *. Float.two_pi *. 0.055 in let pos_angle = i' *. angle_diff in - let pos_rel = V2.(v pos_radius pos_angle |> of_polar) in + let pos_rel = V2.(v pos_radius pos_angle |> of_polar) in (*goo*) 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 From ae3a457d41239a022ec951187e97759f7cdae711 Mon Sep 17 00:00:00 2001 From: rand00 Date: Mon, 17 Jan 2022 19:49:02 +0100 Subject: [PATCH 25/35] Opam_graph: UI: Implemented alternative layer2 deps layout-algorithm (spiral grid) --- src/opam_graph.ml | 93 ++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 75 insertions(+), 18 deletions(-) diff --git a/src/opam_graph.ml b/src/opam_graph.ml index e5add35..0ab77b9 100644 --- a/src/opam_graph.ml +++ b/src/opam_graph.ml @@ -268,7 +268,7 @@ line { } .layer2_deps.bg { - fill: bisque; + fill: url(#gradient_01); } .direct_dep.node:hover { @@ -278,6 +278,10 @@ line { |} (* disabled CSS +.layer2_deps.bg { + fill: bisque; +} + .root:hover ~ .node { transform: scale(1.1); } @@ -450,6 +454,74 @@ line { in svg, css + let make_layer2_nodes_spiral ~layer2_deps ~layer2_deps_center = + let open Gg in + let dot_radius = root_radius *. 0.25 in + layer2_deps |> List.mapi (fun i' layer2_dep -> + let i' = float i' +. 5.5 in + let pos_radius = sqrt i' *. 0.007 -. 0.005 in + let angle_diff = sqrt i' *. Float.two_pi *. 0.005 +. 0.6 in + let pos_angle = i' *. angle_diff in + let pos_rel = V2.(v pos_radius pos_angle |> of_polar) in (*goo*) + 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 classes = [ layer2_dep.name; "layer2_dep" ] in + make_node ~pos ~radius:dot_radius ~text ~classes + ) + + (*goto implement as iterative search*) + let grid_pos ~cell_width i = + let open Gg in + let north = V2.v 0. cell_width in + let west = V2.ortho north in + let south = V2.ortho west in + let east = V2.ortho south + in + let rec aux i' len_side consumed_side dir pos_acc = + if i = i' then pos_acc else + if i' = 0 then + aux (succ i') (len_side +2) 1 `East V2.(north + pos_acc) + else ( + match dir with + | `East -> + if consumed_side = len_side then + aux i' len_side 0 `South pos_acc + else + aux (succ i') len_side (succ consumed_side) dir V2.(east + pos_acc) + | `South -> + if consumed_side = len_side then + aux i' len_side 0 `West pos_acc + else + aux (succ i') len_side (succ consumed_side) dir V2.(south + pos_acc) + | `West -> + if consumed_side = len_side then + aux i' len_side 0 `North pos_acc + else + aux (succ i') len_side (succ consumed_side) dir V2.(west + pos_acc) + | `North -> + if consumed_side = len_side then + aux (succ i') (len_side +2) 1 `East V2.(north + pos_acc) + else + aux (succ i') len_side (succ consumed_side) dir V2.(north + pos_acc) + ) + in + (*> Note most of these args are not used initially..*) + aux 0 0 0 `East V2.(v 0. 0.) + + let make_layer2_nodes_grid ~layer2_deps ~layer2_deps_center = + let open Gg in + let n_layer2_deps = List.length layer2_deps in + let dot_radius = 0.005 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 classes = [ layer2_dep.name; "layer2_dep" ] in + make_node ~pos ~radius:dot_radius ~text ~classes + ) + let make_layer2_deps ~deps_w_positions = let open Gg in deps_w_positions |> List.mapi @@ -461,26 +533,11 @@ line { in V2.(mult * (direct_dep_pos - center) + center) in - let dot_radius = root_radius *. 0.2 - in - let nodes = - layer2_deps |> List.mapi (fun i' layer2_dep -> - let i' = float i' +. 5.5 in - let pos_radius = sqrt i' *. 0.012 -. 0.024 in - let angle_diff = sqrt i' *. Float.two_pi *. 0.055 in - let pos_angle = i' *. angle_diff in - let pos_rel = V2.(v pos_radius pos_angle |> of_polar) in (*goo*) - 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 classes = [ layer2_dep.name; "layer2_dep" ] in - make_node ~pos ~radius:dot_radius ~text ~classes - ) - in + let nodes = make_layer2_nodes_grid ~layer2_deps ~layer2_deps_center in let bg = let pos = { x = V2.x layer2_deps_center; y = V2.y layer2_deps_center } - and radius = sqrt (float (List.length layer2_deps) +. 1.) *. 0.009 + and radius = sqrt (float (List.length layer2_deps) +. 1.) *. 0.0115 and text = "" and classes = [ "layer2_deps"; "bg"; dep.name ] in make_node ~pos ~radius ~text ~classes From 0d92f5c9acfb35268b44a801d381c4e44910026a Mon Sep 17 00:00:00 2001 From: rand00 Date: Mon, 17 Jan 2022 19:59:12 +0100 Subject: [PATCH 26/35] Opam_graph: UI: Syntax, comments and removed redundant logic in grid-algo --- src/opam_graph.ml | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/src/opam_graph.ml b/src/opam_graph.ml index 0ab77b9..96fdcd0 100644 --- a/src/opam_graph.ml +++ b/src/opam_graph.ml @@ -403,7 +403,7 @@ line { radius_pos1_rel *. 1.2 in let bottom_width = if diff_angle < Float.pi_div_2 then - sin diff_angle *. height_triangle (*Note: Scaling sin by radius*) + sin diff_angle *. height_triangle (*Note: Scaling sin by ~ circle-radius*) else height_triangle in @@ -415,7 +415,8 @@ line { let pos1_extended = V2.(height_triangle * pos1_unit + center) in let right = V2.(right_leg + pos1_extended) and left = V2.(left_leg + pos1_extended) in - { x = V2.x left; y = V2.y left }, { x = V2.x right; y = V2.y right } + { x = V2.x left; y = V2.y left }, + { x = V2.x right; y = V2.y right } in Svg.g ~a [ title; make_triangle ~top:pos0 ~left ~right ] @@ -479,10 +480,7 @@ line { let east = V2.ortho south in let rec aux i' len_side consumed_side dir pos_acc = - if i = i' then pos_acc else - if i' = 0 then - aux (succ i') (len_side +2) 1 `East V2.(north + pos_acc) - else ( + if i = i' then pos_acc else ( match dir with | `East -> if consumed_side = len_side then @@ -501,12 +499,12 @@ line { aux (succ i') len_side (succ consumed_side) dir V2.(west + pos_acc) | `North -> if consumed_side = len_side then + (*> Note special case of jumping to next 'level'*) aux (succ i') (len_side +2) 1 `East V2.(north + pos_acc) else aux (succ i') len_side (succ consumed_side) dir V2.(north + pos_acc) ) in - (*> Note most of these args are not used initially..*) aux 0 0 0 `East V2.(v 0. 0.) let make_layer2_nodes_grid ~layer2_deps ~layer2_deps_center = From 9c6d140c43b55ec7a09055d6431b0699a6d287a6 Mon Sep 17 00:00:00 2001 From: rand00 Date: Wed, 19 Jan 2022 16:36:20 +0100 Subject: [PATCH 27/35] Opam_graph: UI: Bigger hitboxes for layer2 deps --- src/opam_graph.ml | 46 ++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 40 insertions(+), 6 deletions(-) diff --git a/src/opam_graph.ml b/src/opam_graph.ml index 96fdcd0..99fdeda 100644 --- a/src/opam_graph.ml +++ b/src/opam_graph.ml @@ -290,8 +290,6 @@ line { stroke-width: 0.009 !important; *) - let merge_css cs = String.concat "\n" cs - (*< Note the '.layer2_deps.bg' selector... https://steveliles.github.io/a_multi_class_union_css_selector.html*) (* .layer2_deps.bg fills: @@ -299,6 +297,8 @@ line { CSS: fill: url(#gradient_01); *) + let merge_css cs = String.concat "\n" cs + type position = { x : float; y : float; @@ -320,13 +320,31 @@ line { let make_circle ~pos ~radius = Svg.[ circle ~a:[ - a_class ["node_circle"]; + a_class ["node_circle"]; a_cx @@ Unit.none pos.x; a_cy @@ Unit.none pos.y; a_r @@ Unit.none radius; ] [] ] + let make_rect ~center_pos ~width = + let open Gg in + let center_pos = V2.v center_pos.x center_pos.y in + let diagonal = V2.v width width in + let center_displacement = V2.half diagonal in + let pos = V2.(center_pos - center_displacement) in + Svg.[ + rect ~a:[ + (* a_stroke @@ `Color ("black", None); + * a_stroke_width @@ Unit.none 0.001; *) + a_fill @@ `Color ("rgba(0,0,0,0)", None); (*goto control with css*) + a_x @@ Unit.none @@ V2.x pos; + a_y @@ Unit.none @@ V2.y pos; + a_width @@ Unit.none width; + a_height @@ Unit.none width; + ] [] + ] + let make_node ~pos ~radius ~text ~classes = let title = make_title ~text in (*> todo; why is this not in Tyxml - browser support missing?*) @@ -463,7 +481,7 @@ line { let pos_radius = sqrt i' *. 0.007 -. 0.005 in let angle_diff = sqrt i' *. Float.two_pi *. 0.005 +. 0.6 in let pos_angle = i' *. angle_diff in - let pos_rel = V2.(v pos_radius pos_angle |> of_polar) in (*goo*) + 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 @@ -506,7 +524,17 @@ line { ) in aux 0 0 0 `East V2.(v 0. 0.) - + + let make_hitbox_square ~center_pos ~width ~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 a = Svg.[ + a_class ("hitbox" :: classes); + a_transform_origin @@ sprintf "%f %f" center_pos.x center_pos.y; + ] in + Svg.g ~a (title :: make_rect ~center_pos ~width) + let make_layer2_nodes_grid ~layer2_deps ~layer2_deps_center = let open Gg in let n_layer2_deps = List.length layer2_deps in @@ -517,8 +545,14 @@ line { let pos = { x = V2.x pos; y = V2.y pos } in let text = layer2_dep.name in let classes = [ layer2_dep.name; "layer2_dep" ] in - make_node ~pos ~radius:dot_radius ~text ~classes + let visual_svg = make_node ~pos ~radius:dot_radius ~text ~classes in + let hitbox_svg = + make_hitbox_square ~text ~classes + ~center_pos:pos + ~width:cell_width in + [ visual_svg; hitbox_svg ] ) + |> List.flatten let make_layer2_deps ~deps_w_positions = let open Gg in From 0a875c2e35609302b2e49c83de10653c9e04e965 Mon Sep 17 00:00:00 2001 From: rand00 Date: Wed, 19 Jan 2022 17:43:44 +0100 Subject: [PATCH 28/35] Opam_graph: UI: Played around with hitbox for layer2 deps to fix firefox hover-hitbox - firefox seems broken vs chromium --- src/opam_graph.ml | 22 +++++++++++++++++----- 1 file changed, 17 insertions(+), 5 deletions(-) diff --git a/src/opam_graph.ml b/src/opam_graph.ml index 99fdeda..959256c 100644 --- a/src/opam_graph.ml +++ b/src/opam_graph.ml @@ -275,6 +275,10 @@ line { transform: scale(2); } +.layer2_dep.node:hover { + transform: scale(1.4); +} + |} (* disabled CSS @@ -327,7 +331,7 @@ line { ] [] ] - let make_rect ~center_pos ~width = + let make_square ~center_pos ~width = let open Gg in let center_pos = V2.v center_pos.x center_pos.y in let diagonal = V2.v width width in @@ -336,7 +340,7 @@ line { Svg.[ rect ~a:[ (* a_stroke @@ `Color ("black", None); - * a_stroke_width @@ Unit.none 0.001; *) + * a_stroke_width @@ Unit.none 0.001; *) a_fill @@ `Color ("rgba(0,0,0,0)", None); (*goto control with css*) a_x @@ Unit.none @@ V2.x pos; a_y @@ Unit.none @@ V2.y pos; @@ -390,9 +394,17 @@ line { .direct_dep.node.%s:hover ~ .layer2_deps.bg.%s { fill: dimgrey; } -|} dep dep dep dep dep dep +|} dep dep dep dep dep dep (*< goto move generation of node-css to some other place*) + (*disabled css: +(*> problem: selected other following children as well*) +.layer2_dep.hitbox.%s:hover ~ .layer2_dep.node.%s { + transform: scale(1.4); +} + +*) + let make_triangle ~top ~left ~right = let a = Svg.[ a_points [ @@ -533,7 +545,7 @@ line { a_class ("hitbox" :: classes); a_transform_origin @@ sprintf "%f %f" center_pos.x center_pos.y; ] in - Svg.g ~a (title :: make_rect ~center_pos ~width) + Svg.g ~a (title :: make_square ~center_pos ~width) let make_layer2_nodes_grid ~layer2_deps ~layer2_deps_center = let open Gg in @@ -550,7 +562,7 @@ line { make_hitbox_square ~text ~classes ~center_pos:pos ~width:cell_width in - [ visual_svg; hitbox_svg ] + [ (* hitbox_svg; *)visual_svg ] ) |> List.flatten From 07d81a6073f584d9040b342f4035820fd6d9b778 Mon Sep 17 00:00:00 2001 From: rand00 Date: Wed, 26 Jan 2022 18:06:23 +0100 Subject: [PATCH 29/35] Opam_graph: Passing out svg attributes and content to outer Html.svg node - fixes UI too --- src/opam_graph.ml | 32 ++++++++++++++++++++------------ 1 file changed, 20 insertions(+), 12 deletions(-) diff --git a/src/opam_graph.ml b/src/opam_graph.ml index 959256c..e6e1a38 100644 --- a/src/opam_graph.ml +++ b/src/opam_graph.ml @@ -242,9 +242,12 @@ module Render = struct module Svg = struct type t = Tyxml_svg.doc + type 'a elt = 'a Tyxml_svg.elt + type 'a attr = 'a Tyxml_svg.attrib - type output = { - svg : t; + type ('a, 'b) output = { + svg_content : 'a elt list; + svg_attr : 'b attr list; css : string; } @@ -257,8 +260,6 @@ module Render = struct let initial_css = {| svg { - width : 100vw; - height : 100vh; background : slategrey; } @@ -282,6 +283,11 @@ line { |} (* disabled CSS +svg { + width : 100vw; + height : 100vh; +} + .layer2_deps.bg { fill: bisque; } @@ -675,9 +681,9 @@ line { ] ]] - let of_assoc (graph:assoc_graph) : output = + let of_assoc (graph:assoc_graph) : _ output = match graph with - | [] -> { svg = Tyxml_svg.svg []; css = "" } + | [] -> { svg_content = []; svg_attr = []; css = "" } | (root_pkg, direct_deps) :: layer2_deps -> let root_svg = let pos = center @@ -689,10 +695,10 @@ line { make_node ~pos ~radius ~text ~classes in let deps_svgs, deps_css = make_deps layer2_deps in - let a = [ Svg.a_viewBox (0., 0., 1., 1.) ] in - let svg = Svg.svg ~a (svg_defs @ (root_svg :: deps_svgs)) in + let svg_attr = [ Svg.a_viewBox (0., 0., 1., 1.) ] in + let svg_content = svg_defs @ (root_svg :: deps_svgs) in let css = merge_css [ initial_css; deps_css ] in - { svg; css } + { svg_content; svg_attr; css } let pp ppf html = Format.fprintf ppf "%a@." (Tyxml_svg.pp ()) html @@ -705,14 +711,16 @@ line { type t = H.doc - let of_assoc (graph:assoc_graph) : t = + let merge_css = String.concat "\n" + + let of_assoc ?(override_css="") (graph:assoc_graph) : t = let svg = Svg.of_assoc graph in H.html (H.head (H.title (H.txt "Dependencies")) - [H.style [H.Unsafe.data svg.css]] + [H.style [H.Unsafe.data @@ merge_css [ svg.css; override_css ]]] ) - (H.body [ H.svg [ svg.svg ] ]) + (H.body [ H.svg ~a:svg.svg_attr svg.svg_content ]) let pp ppf html = Format.fprintf ppf "%a@." (Tyxml_html.pp ()) html From 9bee347c176388e37c32e31d660469bfc1fc6914 Mon Sep 17 00:00:00 2001 From: rand00 Date: Wed, 26 Jan 2022 21:15:12 +0100 Subject: [PATCH 30/35] Opam_graph: Changed color of shared-deps nodes --- 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 e6e1a38..966f41b 100644 --- a/src/opam_graph.ml +++ b/src/opam_graph.ml @@ -608,7 +608,7 @@ svg { shared_deps |> Seq.map (fun shared_dep -> sprintf {| .direct_dep.%s:hover ~ .node.layer2_dep.%s { - fill: hotpink; + fill: #5454ff; } |} dep.name shared_dep ) From 82f99de39cc346d8dad46fd86c35a0cf2fe5c67d Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Thu, 27 Jan 2022 12:58:01 +0100 Subject: [PATCH 31/35] use cmdliner --- app/dune | 2 +- app/main.ml | 91 +++++++++++++++++++++++++++++------------------------ 2 files changed, 51 insertions(+), 42 deletions(-) diff --git a/app/dune b/app/dune index bf82a93..2fe3b23 100644 --- a/app/dune +++ b/app/dune @@ -1,4 +1,4 @@ (executable (name main) (public_name opam_graph) - (libraries cmdliner logs logs.fmt opam-graph)) + (libraries cmdliner logs logs.fmt fmt.cli fmt.tty logs.cli opam-graph)) diff --git a/app/main.ml b/app/main.ml index 2dd5b13..b10ac1e 100644 --- a/app/main.ml +++ b/app/main.ml @@ -11,45 +11,54 @@ let read_file file = invalid_arg ("Error reading file: " ^ file) with _ -> invalid_arg ("Error opening file " ^ file) -let () = - match Sys.argv with - | [| _ ; output_format; file |] -> ( - let switch = read_file file in - let data = OpamFile.SwitchExport.read_from_string switch in - match output_format with - | "text" -> - let graph = Opam_graph.dependencies data in - Format.printf "%a" Opam_graph.pp_graph graph - | "text_transitive" -> - let graph = Opam_graph.dependencies ~transitive:true data in - Format.printf "%a" Opam_graph.pp_graph graph - | "dot" -> - let graph = Opam_graph.dependencies data in - let dot = Opam_graph.Render.Dot.of_graph graph in - Format.printf "%a" Opam_graph.Render.Dot.pp dot - | "dot_ui" -> - let transitive = false in - let graph = Opam_graph.Ui.dependencies ~transitive data in - let dot = Opam_graph.Render.Dot.of_assoc graph in - Format.printf "%a" Opam_graph.Render.Dot.pp dot - | "dot_ui_transitive" -> - let transitive = true in - let graph = Opam_graph.Ui.dependencies ~transitive data in - let dot = Opam_graph.Render.Dot.of_assoc graph in - Format.printf "%a" Opam_graph.Render.Dot.pp dot - | "html_ui" -> - let transitive = false in - let graph = Opam_graph.Ui.dependencies ~transitive data in - let html = Opam_graph.Render.Html.of_assoc graph in - Format.printf "%a" Opam_graph.Render.Html.pp html - | "html_ui_transitive" -> - let transitive = true in - let graph = Opam_graph.Ui.dependencies ~transitive data in - let html = Opam_graph.Render.Html.of_assoc graph in - Format.printf "%a" Opam_graph.Render.Html.pp html - | _ -> failwith "Unsupported output format" - ) - | _ -> - print_endline "expecting exactly one argument"; - exit 1 +let jump () transitive file output_format = + let switch = read_file file in + let data = OpamFile.SwitchExport.read_from_string switch in + match output_format with + | `Text -> + let graph = Opam_graph.dependencies ~transitive data in + Format.printf "%a" Opam_graph.pp_graph graph + | `Dot -> + let graph = Opam_graph.dependencies ~transitive data in + let dot = Opam_graph.Render.Dot.of_graph graph in + Format.printf "%a" Opam_graph.Render.Dot.pp dot + | `Dot_ui -> + let graph = Opam_graph.Ui.dependencies ~transitive data in + let dot = Opam_graph.Render.Dot.of_assoc graph in + Format.printf "%a" Opam_graph.Render.Dot.pp dot + | `Html -> + let graph = Opam_graph.Ui.dependencies ~transitive data in + let html = Opam_graph.Render.Html.of_assoc graph in + Format.printf "%a" Opam_graph.Render.Html.pp html +let setup_log style_renderer level = + Fmt_tty.setup_std_outputs ?style_renderer (); + Logs.set_level level; + Logs.set_reporter (Logs_fmt.reporter ~dst:Format.std_formatter ()) + +open Cmdliner + +let setup_log = + Term.(const setup_log + $ Fmt_cli.style_renderer () + $ Logs_cli.level ()) + +let transitive = + let doc = "Transitive dependencies" in + Arg.(value & flag & info [ "transitive" ] ~doc) + +let formats = [ "html", `Html ; "dot", `Dot ; "dot-ui", `Dot_ui ; "text", `Text ] + +let output_format = + let doc = "Output format" in + Arg.(value & opt (Arg.enum formats) `Text & info [ "output-format" ] ~doc) + +let file = + let doc = "The opam switch export to graph" in + Arg.(required & pos 0 (some file) None & info [ ] ~doc ~docv:"FILE") + +let cmd = + Term.(const jump $ setup_log $ transitive $ file $ output_format), + Term.info "opam_graph" ~version:"%%VERSION%%" + +let () = match Term.eval cmd with `Ok () -> exit 0 | _ -> exit 1 From 2bd5d0eae3dc4eb44d8bfd9968ae5c8148a8148f Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Thu, 27 Jan 2022 12:58:39 +0100 Subject: [PATCH 32/35] whitespace cleanups, removed removal of warnings --- src/dune | 1 - src/opam_graph.ml | 96 +++++++++++++++++++++++------------------------ 2 files changed, 47 insertions(+), 50 deletions(-) diff --git a/src/dune b/src/dune index 126c29b..54bb00c 100644 --- a/src/dune +++ b/src/dune @@ -2,5 +2,4 @@ (name opam_graph) (public_name opam-graph) (libraries opam-core opam-format dot rresult tyxml gg) - (flags (:standard (-w -27-26))) ) diff --git a/src/opam_graph.ml b/src/opam_graph.ml index 966f41b..c83e230 100644 --- a/src/opam_graph.ml +++ b/src/opam_graph.ml @@ -34,7 +34,7 @@ let direct_dependencies (switch : OpamFile.SwitchExport.t) pkg = let transitive_dependencies (switch : OpamFile.SwitchExport.t) pkg = let available = switch.selections.sel_installed in - let rec aux pkg seen_pkgs = + let rec aux pkg seen_pkgs = let opam = opam_file switch pkg in let set = filtered_formula_to_pkgs switch (OpamFile.OPAM.depends opam) in let set = filtered_formula_to_pkgs switch ~set (OpamFile.OPAM.depopts opam) in @@ -80,7 +80,6 @@ let pp_graph ppf graph = graph.nodes let dependencies ?(transitive=false) (switch : OpamFile.SwitchExport.t) = - let available = switch.selections.sel_installed in let root_pkg = root switch in let top = root_pkg.OpamPackage.name in let graph = { top ; nodes = Name_map.empty } in @@ -90,7 +89,7 @@ let dependencies ?(transitive=false) (switch : OpamFile.SwitchExport.t) = | None -> graph | Some x -> let deps = match transitive with - | true -> transitive_dependencies switch x + | true -> transitive_dependencies switch x | false -> direct_dependencies switch x in let deps = @@ -117,7 +116,7 @@ type assoc_node = { uniqueness_postfix : string; } type assoc_graph = (assoc_node * (assoc_node list)) list - + module Ui = struct let dependencies ?(transitive=true) data : assoc_graph = @@ -126,7 +125,7 @@ module Ui = struct let root = all_direct_deps.top in let root_str = OpamPackage.Name.to_string root in - let direct_deps = + let direct_deps = all_direct_deps.nodes |> Name_map.find root in @@ -144,7 +143,7 @@ module Ui = struct | None -> Name_set.empty | Some v -> v) |> Name_set.elements - |> List.map OpamPackage.Name.to_string + |> List.map OpamPackage.Name.to_string in let direct_dep = OpamPackage.Name.to_string direct_dep in direct_dep, transitive_deps @@ -174,7 +173,7 @@ module Ui = struct end -module Render = struct +module Render = struct module Dot = struct @@ -189,7 +188,7 @@ module Render = struct let pkg_point = Edge_node_id (pkg_id, None) in let deps_points = Name_set.elements deps - |> List.map (fun p -> + |> List.map (fun p -> let id = Double_quoted_id (OpamPackage.Name.to_string p) in Edge_node_id (id, None) ) @@ -207,7 +206,7 @@ module Render = struct let id_of_assoc_node node = sprintf "%s_%s" node.name node.uniqueness_postfix - + let of_assoc (graph:assoc_graph) : t = let open Odot in let stmt_list = @@ -218,7 +217,7 @@ module Render = struct let pkg_point = Edge_node_id (pkg_id, None) in let deps_points = deps - |> List.map (fun pkg -> + |> List.map (fun pkg -> let id = Double_quoted_id (id_of_assoc_node pkg) in Edge_node_id (id, None) ) @@ -227,7 +226,7 @@ module Render = struct Stmt_edge edge in stmt :: acc - ) [] + ) [] in { strict = false; (*todo test params*) kind = Digraph; @@ -282,8 +281,8 @@ line { |} - (* disabled CSS -svg { + (* disabled CSS +svg { width : 100vw; height : 100vh; } @@ -300,23 +299,23 @@ svg { stroke-width: 0.009 !important; *) - (*< Note the '.layer2_deps.bg' selector... + (*< Note the '.layer2_deps.bg' selector... https://steveliles.github.io/a_multi_class_union_css_selector.html*) (* .layer2_deps.bg fills: - OCaml: a_fill @@ `Color ("url(#gradient_01)", None); + OCaml: a_fill @@ `Color ("url(#gradient_01)", None); CSS: fill: url(#gradient_01); *) let merge_css cs = String.concat "\n" cs - + type position = { x : float; y : float; } let center = { x = 0.5; y = 0.5 } - let root_radius = 0.015 - + let root_radius = 0.015 + module Unit = struct let none size = size, None @@ -330,7 +329,7 @@ svg { let make_circle ~pos ~radius = Svg.[ circle ~a:[ - a_class ["node_circle"]; + a_class ["node_circle"]; a_cx @@ Unit.none pos.x; a_cy @@ Unit.none pos.y; a_r @@ Unit.none radius; @@ -345,7 +344,7 @@ svg { let pos = V2.(center_pos - center_displacement) in Svg.[ rect ~a:[ - (* a_stroke @@ `Color ("black", None); + (* a_stroke @@ `Color ("black", None); * a_stroke_width @@ Unit.none 0.001; *) a_fill @@ `Color ("rgba(0,0,0,0)", None); (*goto control with css*) a_x @@ Unit.none @@ V2.x pos; @@ -354,7 +353,7 @@ svg { a_height @@ Unit.none width; ] [] ] - + let make_node ~pos ~radius ~text ~classes = let title = make_title ~text in (*> todo; why is this not in Tyxml - browser support missing?*) @@ -378,14 +377,14 @@ svg { let title = make_title ~text in Svg.g ~a [ title; make_line ~pos0 ~pos1 ] - let make_direct_dep_text dep ~layer2_deps = + let make_direct_dep_text dep ~layer2_deps = sprintf "Direct dependency: %s\nDirect dependencies: %d" dep.name (List.length layer2_deps) let make_direct_deps_nodes ~deps_w_positions = 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 and classes = [ dep.name; "direct_dep" ] in make_node ~pos ~radius ~text ~classes ) @@ -400,7 +399,7 @@ svg { .direct_dep.node.%s:hover ~ .layer2_deps.bg.%s { fill: dimgrey; } -|} dep dep dep dep dep dep +|} dep dep dep dep dep dep (*< goto move generation of node-css to some other place*) (*disabled css: @@ -410,7 +409,7 @@ svg { } *) - + let make_triangle ~top ~left ~right = let a = Svg.[ a_points [ @@ -419,26 +418,26 @@ svg { right.x, right.y; ]; a_fill @@ `Color ("rgba(0,0,0,0)", None); (*goto control with css*) - (* a_stroke @@ `Color ("black", None); + (* a_stroke @@ `Color ("black", None); * a_stroke_width @@ Unit.none 0.002; *) ] in Svg.polygon ~a [] - + let make_hitbox_direct_dep_edge ~pos0 ~pos1 ~n_edges ~text ~classes = let a = [ Svg.a_class ("edge" :: "hitbox" :: classes) ] in let title = make_title ~text in - let left, right = + let left, right = let open Gg in let n_edges = float (max 1 n_edges) in - let diff_angle = Float.two_pi /. n_edges in - let pos0, pos1 = V2.(v pos0.x pos0.y, v pos1.x pos1.y) in + let diff_angle = Float.two_pi /. n_edges in + let _pos0, pos1 = V2.(v pos0.x pos0.y, v pos1.x pos1.y) in let center = V2.v center.x center.y in let pos1_rel = V2.(pos1 - center) in let height_triangle = let radius_pos1_rel, _ = V2.(to_polar pos1_rel |> to_tuple) in radius_pos1_rel *. 1.2 in let bottom_width = - if diff_angle < Float.pi_div_2 then + if diff_angle < Float.pi_div_2 then sin diff_angle *. height_triangle (*Note: Scaling sin by ~ circle-radius*) else height_triangle @@ -455,14 +454,14 @@ svg { { x = V2.x right; y = V2.y right } in Svg.g ~a [ title; make_triangle ~top:pos0 ~left ~right ] - + let make_direct_deps_edges ~deps_w_positions = let open Gg in let n_edges = deps_w_positions |> List.length in let svg = deps_w_positions |> List.concat_map (fun ((dep, pos), layer2_deps) -> let pos1 = pos in - let pos0, pos0_angle = + let pos0, _pos0_angle = (*> Note: Need this because of mix of CSS selectors and SVG paint order*) let center = V2.v center.x center.y in let pos1 = V2.v pos1.x pos1.y in @@ -499,7 +498,7 @@ svg { let pos_radius = sqrt i' *. 0.007 -. 0.005 in let angle_diff = sqrt i' *. Float.two_pi *. 0.005 +. 0.6 in let pos_angle = i' *. angle_diff in - let pos_rel = V2.(v pos_radius pos_angle |> of_polar) in + 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 @@ -555,7 +554,6 @@ svg { let make_layer2_nodes_grid ~layer2_deps ~layer2_deps_center = let open Gg in - let n_layer2_deps = List.length layer2_deps in let dot_radius = 0.005 in let cell_width = dot_radius *. 2.5 in layer2_deps |> List.mapi (fun i layer2_dep -> @@ -564,8 +562,8 @@ svg { let text = layer2_dep.name in let classes = [ layer2_dep.name; "layer2_dep" ] in let visual_svg = make_node ~pos ~radius:dot_radius ~text ~classes in - let hitbox_svg = - make_hitbox_square ~text ~classes + let _hitbox_svg = + make_hitbox_square ~text ~classes ~center_pos:pos ~width:cell_width in [ (* hitbox_svg; *)visual_svg ] @@ -614,10 +612,10 @@ svg { ) |> List.of_seq |> merge_css - + let make_shared_deps_css ~deps_w_positions = let module SSet = Set.Make(String) in - let sset_of_deps deps = + let sset_of_deps deps = deps |> List.map (fun dep -> dep.name) |> SSet.of_list @@ -639,7 +637,7 @@ svg { make_shared_deps_css_aux ~dep ~shared_deps ) |> merge_css - + let make_deps (deps:assoc_graph) = let deps_w_positions = let open Gg in @@ -654,15 +652,15 @@ 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 + and direct_deps_nodes = make_direct_deps_nodes ~deps_w_positions and layer2_deps = make_layer2_deps ~deps_w_positions - and shared_deps_css = make_shared_deps_css ~deps_w_positions + and shared_deps_css = make_shared_deps_css ~deps_w_positions in let svg = direct_deps_edges @ direct_deps_nodes @ layer2_deps in let css = merge_css [ direct_deps_edges_css; shared_deps_css ] in svg, css - + let svg_defs = Svg.[ defs [ radialGradient ~a:[ a_id "gradient_01"; @@ -704,15 +702,15 @@ svg { Format.fprintf ppf "%a@." (Tyxml_svg.pp ()) html end - + module Html = struct module H = Tyxml_html type t = H.doc - let merge_css = String.concat "\n" - + let merge_css = String.concat "\n" + let of_assoc ?(override_css="") (graph:assoc_graph) : t = let svg = Svg.of_assoc graph in H.html @@ -724,7 +722,7 @@ svg { let pp ppf html = Format.fprintf ppf "%a@." (Tyxml_html.pp ()) html - + end - + end From 80e9a68e5bf141948a492a92f1a09d9f135c521c Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Thu, 27 Jan 2022 12:58:49 +0100 Subject: [PATCH 33/35] flesh out opam file --- opam-graph.opam | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/opam-graph.opam b/opam-graph.opam index e69de29..8ab3aa8 100644 --- a/opam-graph.opam +++ b/opam-graph.opam @@ -0,0 +1,30 @@ +opam-version: "2.0" +maintainer: "Robur " +authors: ["Robur "] +homepage: "https://git.robur.io/robur/opam-graph" +dev-repo: "git+https://git.robur.io/robur/opam-graph.git" +bug-reports: "https://github.com/roburio/opam-graph/issues" +license: "ISC" + +depends: [ + "ocaml" {>= "4.08.0"} + "dune" {>= "2.0.0"} + "cmdliner" + "fmt" {>= "0.8.7"} + "logs" + "opam-core" + "opam-format" + "ocamldot" + "rresult" + "tyxml" + "gg" +] +build: [ + ["dune" "subst"] {dev} + ["dune" "build" "-p" name "-j" jobs] +] + +synopsis: "Graphing dependencies of opam packages" +description: """ +This package outputs graphs (in svg and dot) of opam packages. +""" From 95962767d2a072e61ca24ae24ca9ed5179658f0a Mon Sep 17 00:00:00 2001 From: rand00 Date: Fri, 28 Jan 2022 11:37:00 +0100 Subject: [PATCH 34/35] app/main.ml: Added output-format enum to cmdliner doc --- app/main.ml | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/app/main.ml b/app/main.ml index b10ac1e..dfc0c83 100644 --- a/app/main.ml +++ b/app/main.ml @@ -50,7 +50,11 @@ let transitive = let formats = [ "html", `Html ; "dot", `Dot ; "dot-ui", `Dot_ui ; "text", `Text ] let output_format = - let doc = "Output format" in + let doc = + let formats_str = + formats |> List.map fst |> String.concat ", " + in + Printf.sprintf "Output format. Can be one of: %s." formats_str in Arg.(value & opt (Arg.enum formats) `Text & info [ "output-format" ] ~doc) let file = From 1e7a4867b3b1ab1077e85c7638ed88e949756dd3 Mon Sep 17 00:00:00 2001 From: rand00 Date: Fri, 28 Jan 2022 11:42:45 +0100 Subject: [PATCH 35/35] .gitignore --- .gitignore | 4 ++++ 1 file changed, 4 insertions(+) create mode 100644 .gitignore diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..ba7ce2a --- /dev/null +++ b/.gitignore @@ -0,0 +1,4 @@ +_build +*~ +*# +