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

WIP: Begun implementing svg UI based on scaleable idea for hover-effects + Changed cli-interface

Browse source
This commit is contained in:
rand00 2022-01-11 13:47:59 +01:00
parent 0b21c30cc2
commit 47a4c37c76
3 changed files with 123 additions and 75 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

32
app/main.ml
View file

@ -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"
)
| _ ->

2
src/dune
View file

@ -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)))
)

162
src/opam_graph.ml
View file

@ -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 }
(*!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