1(** Custom generator to perform test on ocamldoc. *)
2
3open Odoc_info
4open Odoc_info.Module
5open Odoc_info.Type
6
7type test_kind =
8    Types_display
9
10let p = Format.fprintf
11
12class string_gen =
13  object(self)
14    inherit Odoc_info.Scan.scanner
15
16    val mutable test_kinds = []
17    val mutable fmt = Format.str_formatter
18
19    method must_display_types = List.mem Types_display test_kinds
20
21    method set_test_kinds_from_module m =
22      test_kinds <- List.fold_left
23          (fun acc (s, _) ->
24            match s with
25              "test_types_display" -> Types_display :: acc
26            | _ -> acc
27          )
28          []
29          (
30           match m.m_info with
31             None -> []
32           | Some i -> i.i_custom
33          )
34    method! scan_type t =
35      match test_kinds with
36        [] -> ()
37      | _ ->
38          p fmt "# type %s:\n" t.ty_name;
39          if self#must_display_types then
40            (
41             p fmt "# manifest (Odoc_info.string_of_type_expr):\n<[%s]>\n"
42               (match t.ty_manifest with
43                 None -> "None"
44               | Some (Other e) -> Odoc_info.string_of_type_expr e
45               | Some (Object_type fields) ->
46                 let b = Buffer.create 256 in
47                 Buffer.add_string b "<";
48                 List.iter
49                   (fun fd ->
50                     Printf.bprintf b " %s: %s ;"
51                       fd.of_name
52                       (Odoc_info.string_of_type_expr fd.of_type)
53                   )
54                   fields;
55                 Buffer.add_string b " >";
56                 Buffer.contents b
57               );
58            );
59
60
61    method! scan_module_pre m =
62      p fmt "#\n# module %s:\n" m.m_name ;
63      if self#must_display_types then
64        (
65         p fmt "# Odoc_info.string_of_module_type:\n<[%s]>\n"
66           (Odoc_info.string_of_module_type m.m_type);
67         p fmt "# Odoc_info.string_of_module_type ~complete: true :\n<[%s]>\n"
68           (Odoc_info.string_of_module_type ~complete: true m.m_type);
69        );
70      true
71
72    method! scan_module_type_pre m =
73      p fmt "#\n# module type %s:\n" m.mt_name ;
74      if self#must_display_types then
75        (
76         p fmt "# Odoc_info.string_of_module_type:\n<[%s]>\n"
77           (match m.mt_type with
78             None -> "None"
79           | Some t -> Odoc_info.string_of_module_type t
80           );
81         p fmt "# Odoc_info.string_of_module_type ~complete: true :\n<[%s]>\n"
82           (match m.mt_type with
83             None -> "None"
84           | Some t -> Odoc_info.string_of_module_type ~complete: true t
85           );
86        );
87      true
88
89    method generate (module_list: Odoc_info.Module.t_module list) =
90      let oc = open_out !Odoc_info.Global.out_file in
91      fmt <- Format.formatter_of_out_channel oc;
92      (
93       try
94         List.iter
95           (fun m ->
96             self#set_test_kinds_from_module m;
97             self#scan_module_list [m];
98           )
99           module_list
100       with
101         e ->
102           prerr_endline (Printexc.to_string e)
103      );
104      Format.pp_print_flush fmt ();
105      close_out oc
106  end
107
108let _ =
109  let module My_generator = struct
110    class generator =
111    let inst = new string_gen in
112    object
113      method generate = inst#generate
114    end
115  end in
116  Odoc_args.set_generator (Odoc_gen.Base (module My_generator : Odoc_gen.Base))
117