Find recursive dependencies, output into a dot file
#!/usr/bin/env ocaml | |
#use "topfind" | |
#require "findlib" | |
#require "astring" | |
let requires name = | |
try | |
let reqs = Findlib.package_property ["native"] name "requires" in | |
Astring.String.cuts ~empty:false ~sep:" " reqs | |
with Not_found -> [] | |
let version name = | |
try | |
let v = Findlib.package_property ["native"] name "version" in | |
if Astring.String.is_infix ~affix:"distributed with O" v then | |
"ocaml" | |
else | |
v | |
with Not_found -> "0" | |
module SM = Map.Make(String) | |
let deps start = | |
let rec one (s, acc) name = | |
if SM.mem name s then | |
(s, acc) | |
else | |
try | |
let direct = requires name in | |
let v = version name in | |
let acc = (name, direct) :: acc in | |
let s = SM.add name v s in | |
List.fold_left one (s, acc) direct | |
with | |
_ -> (s, acc) | |
in | |
List.fold_left one (SM.empty, []) start | |
let p_edge (n, ds) = | |
List.map (fun o -> Printf.sprintf "\"%s\" -> \"%s\"" n o) ds | |
let ca, cb, cc = ( "#C02942", "#ECD078", "#D95B43" ) | |
let p_node top k v acc = | |
let l, c = | |
if v = "ocaml" then | |
(k, ca) | |
else if List.mem k top then | |
(k ^ "\n" ^ v, cb) | |
else | |
(k ^ "\n" ^ v, cc) | |
in | |
Printf.sprintf "\"%s\" [label=\"%s\" fillcolor=\"%s\" style=filled]" k l c :: acc | |
let print_deps name pkgs = | |
let pkgs = List.flatten (List.map (Astring.String.cuts ~empty:false ~sep:",") pkgs) in | |
let map, deps = deps pkgs in | |
let nodes = SM.fold (p_node pkgs) map [] in | |
let edges = List.flatten (List.map p_edge deps) in | |
Printf.printf "digraph \"%s\" {\n %s;\n\n\n %s;\n}\n" name | |
(String.concat ";\n " nodes) | |
(String.concat ";\n " edges) | |
let () = match List.tl (Array.to_list Sys.argv) with | |
| [] -> print_endline "no input, no output" | |
| [name] -> print_endline "need a graph name and packages" | |
| name::pkgs -> print_deps name pkgs | |
(* call ./package.ml mirage-console functoria.runtime,mirage-console.unix,mirage-types.lwt,mirage-unix,mirage.runtime > mirage-console.dot *) | |
(* postprocessing: dot -T svg x.dot > x.svg *) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment