1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
(***********************************************************************)
(* Ocamldoc *)
(* *)
(* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 2001 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)
(* $Id: odoc_dot.ml 7619 2006-09-20 11:14:37Z doligez $ *)
(** Definition of a class which outputs a dot file showing
top modules dependencies.*)
open Odoc_info
module F = Format
(** This class generates a dot file showing the top modules dependencies. *)
class dot =
object (self)
(** To store the colors associated to locations of modules. *)
val mutable loc_colors = []
(** the list of modules we know. *)
val mutable modules = []
(** Colors to use when finding new locations of modules. *)
val mutable colors = !Args.dot_colors
(** Graph header. *)
method header =
"digraph G {\n"^
" size=\"10,7.5\";\n"^
" ratio=\"fill\";\n"^
" rotate=90;\n"^
" fontsize=\"12pt\";\n"^
" rankdir = TB ;\n"
method get_one_color =
match colors with
[] -> None
| h :: q ->
colors <- q ;
Some h
method node_color s =
try Some (List.assoc s loc_colors)
with
Not_found ->
match self#get_one_color with
None -> None
| Some c ->
loc_colors <- (s, c) :: loc_colors ;
Some c
method print_module_atts fmt m =
match self#node_color (Filename.dirname m.Module.m_file) with
None -> ()
| Some col -> F.fprintf fmt "\"%s\" [style=filled, color=%s];\n" m.Module.m_name col
method print_type_atts fmt t =
match self#node_color (Name.father t.Type.ty_name) with
None -> ()
| Some col -> F.fprintf fmt "\"%s\" [style=filled, color=%s];\n" t.Type.ty_name col
method print_one_dep fmt src dest =
F.fprintf fmt "\"%s\" -> \"%s\";\n" src dest
method generate_for_module fmt m =
let l = List.filter
(fun n ->
!Args.dot_include_all or
(List.exists (fun m -> m.Module.m_name = n) modules))
m.Module.m_top_deps
in
self#print_module_atts fmt m;
List.iter (self#print_one_dep fmt m.Module.m_name) l
method generate_for_type fmt (t, l) =
self#print_type_atts fmt t;
List.iter
(self#print_one_dep fmt t.Type.ty_name)
l
method generate_types types =
try
let oc = open_out !Args.out_file in
let fmt = F.formatter_of_out_channel oc in
F.fprintf fmt "%s" self#header;
let graph = Odoc_info.Dep.deps_of_types
~kernel: !Args.dot_reduce
types
in
List.iter (self#generate_for_type fmt) graph;
F.fprintf fmt "}\n" ;
F.pp_print_flush fmt ();
close_out oc
with
Sys_error s ->
raise (Failure s)
method generate_modules modules_list =
try
modules <- modules_list ;
let oc = open_out !Args.out_file in
let fmt = F.formatter_of_out_channel oc in
F.fprintf fmt "%s" self#header;
if !Args.dot_reduce then
Odoc_info.Dep.kernel_deps_of_modules modules_list;
List.iter (self#generate_for_module fmt) modules_list;
F.fprintf fmt "}\n" ;
F.pp_print_flush fmt ();
close_out oc
with
Sys_error s ->
raise (Failure s)
(** Generate the dot code in the file {!Odoc_info.Args.out_file}. *)
method generate (modules_list : Odoc_info.Module.t_module list) =
colors <- !Args.dot_colors;
if !Args.dot_types then
self#generate_types (Odoc_info.Search.types modules_list)
else
self#generate_modules modules_list
end
|
