Skip to content

Instantly share code, notes, and snippets.

@hannesm
Last active November 15, 2016 13:21
Show Gist options
  • Save hannesm/bcbe54c5759ed5854f05c8f8eaee4c79 to your computer and use it in GitHub Desktop.
Save hannesm/bcbe54c5759ed5854f05c8f8eaee4c79 to your computer and use it in GitHub Desktop.
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