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

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

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

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