blob: ed9275e7f2c3a3f9a5c8dd498762e4c6d04f9119 (
plain)
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
|
(***********************************************************************)
(* 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. *)
(* *)
(***********************************************************************)
(** 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) =
if !Args.dot_types then
self#generate_types (Odoc_info.Search.types modules_list)
else
self#generate_modules modules_list
end
|
