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