WIP: Begun implementing svg UI based on scaleable idea for hover-effects + Changed cli-interface
This commit is contained in:
parent
0b21c30cc2
commit
47a4c37c76
3 changed files with 123 additions and 75 deletions
32
app/main.ml
32
app/main.ml
|
@ -25,18 +25,28 @@ let () =
|
||||||
Format.printf "%a" Opam_graph.pp_graph graph
|
Format.printf "%a" Opam_graph.pp_graph graph
|
||||||
| "dot" ->
|
| "dot" ->
|
||||||
let graph = Opam_graph.dependencies data in
|
let graph = Opam_graph.dependencies data in
|
||||||
let dot = Opam_graph.Dot.of_graph graph in
|
let dot = Opam_graph.Render.Dot.of_graph graph in
|
||||||
Format.printf "%a" Opam_graph.Dot.pp dot
|
Format.printf "%a" Opam_graph.Render.Dot.pp dot
|
||||||
| "proto_ui_transitive" ->
|
| "dot_ui" ->
|
||||||
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 transitive = false in
|
||||||
let graph = Opam_graph.Ui_prototype.dependencies ~transitive data in
|
let graph = Opam_graph.Ui.dependencies ~transitive data in
|
||||||
let dot = Opam_graph.Dot.of_assoc graph in
|
let dot = Opam_graph.Render.Dot.of_assoc graph in
|
||||||
Format.printf "%a" Opam_graph.Dot.pp dot
|
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"
|
| _ -> failwith "Unsupported output format"
|
||||||
)
|
)
|
||||||
| _ ->
|
| _ ->
|
||||||
|
|
2
src/dune
2
src/dune
|
@ -1,6 +1,6 @@
|
||||||
(library
|
(library
|
||||||
(name opam_graph)
|
(name opam_graph)
|
||||||
(public_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)))
|
(flags (:standard (-w -27-26)))
|
||||||
)
|
)
|
||||||
|
|
|
@ -108,71 +108,13 @@ let dependencies ?(transitive=false) (switch : OpamFile.SwitchExport.t) =
|
||||||
in
|
in
|
||||||
find_deps graph (Name_set.singleton top)
|
find_deps graph (Name_set.singleton top)
|
||||||
|
|
||||||
module Dot = struct
|
(*!Note the first entry is seen as the top node*)
|
||||||
|
type assoc_graph = (string * (string list)) list
|
||||||
|
|
||||||
type t = Odot.graph
|
module Ui = struct
|
||||||
|
|
||||||
let of_graph (graph:graph) : t =
|
let dependencies ?(transitive=true) data : assoc_graph =
|
||||||
let open Odot in
|
(*> todo can be made more efficient*)
|
||||||
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
|
|
||||||
|
|
||||||
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 Ui_prototype = struct
|
|
||||||
|
|
||||||
let dependencies ?(transitive=true) data =
|
|
||||||
let all_direct_deps = dependencies data in
|
let all_direct_deps = dependencies data in
|
||||||
let top = all_direct_deps.top in
|
let top = all_direct_deps.top in
|
||||||
let top_str = OpamPackage.Name.to_string top
|
let top_str = OpamPackage.Name.to_string top
|
||||||
|
@ -181,6 +123,7 @@ module Ui_prototype = struct
|
||||||
all_direct_deps.nodes
|
all_direct_deps.nodes
|
||||||
|> Name_map.find top
|
|> Name_map.find top
|
||||||
in
|
in
|
||||||
|
(*> todo can be made more efficient*)
|
||||||
let all_transitive_deps =
|
let all_transitive_deps =
|
||||||
dependencies ~transitive data in
|
dependencies ~transitive data in
|
||||||
let direct_deps_w_transitive_deps =
|
let direct_deps_w_transitive_deps =
|
||||||
|
@ -218,3 +161,98 @@ module Ui_prototype = struct
|
||||||
(top_str, unique_direct_deps) :: uniquified_deps
|
(top_str, unique_direct_deps) :: uniquified_deps
|
||||||
|
|
||||||
end
|
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
|
||||||
|
|
Loading…
Reference in a new issue