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

Opam_graph: WIP: Implementing deps. UI: Now there is html output via CLI

Browse source
This commit is contained in:
rand00 2022-01-11 15:56:18 +01:00
parent 47a4c37c76
commit 5592e146fd
1 changed files with 64 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

69
src/opam_graph.ml
View file

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