127 lines
4.0 KiB
OCaml
127 lines
4.0 KiB
OCaml
(**************************************************************************)
|
|
(* *)
|
|
(* OCaml *)
|
|
(* *)
|
|
(* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *)
|
|
(* *)
|
|
(* Copyright 2004 Institut National de Recherche en Informatique et *)
|
|
(* en Automatique. *)
|
|
(* *)
|
|
(* All rights reserved. This file is distributed under the terms of *)
|
|
(* the GNU Lesser General Public License version 2.1, with the *)
|
|
(* special exception on linking described in the file LICENSE. *)
|
|
(* *)
|
|
(**************************************************************************)
|
|
|
|
(** Custom generator to perform test on ocamldoc. *)
|
|
|
|
open Odoc_info
|
|
open Odoc_info.Module
|
|
open Odoc_info.Type
|
|
|
|
type test_kind =
|
|
Types_display
|
|
|
|
let p = Format.fprintf
|
|
|
|
module Generator (G : Odoc_gen.Base) =
|
|
struct
|
|
class string_gen =
|
|
object(self)
|
|
inherit Odoc_info.Scan.scanner
|
|
|
|
|
|
val mutable test_kinds = []
|
|
val mutable fmt = Format.str_formatter
|
|
|
|
method must_display_types = List.mem Types_display test_kinds
|
|
|
|
method set_test_kinds_from_module m =
|
|
test_kinds <- List.fold_left
|
|
(fun acc (s, _) ->
|
|
match s with
|
|
"test_types_display" -> Types_display :: acc
|
|
| _ -> acc
|
|
)
|
|
[]
|
|
(
|
|
match m.m_info with
|
|
None -> []
|
|
| Some i -> i.i_custom
|
|
)
|
|
method! scan_type t =
|
|
match test_kinds with
|
|
[] -> ()
|
|
| _ ->
|
|
p fmt "# type %s:\n" t.ty_name;
|
|
if self#must_display_types then
|
|
(
|
|
p fmt "# manifest :\n<[%s]>\n"
|
|
(match t.ty_manifest with
|
|
None -> "None"
|
|
| Some (Object_type _fields) -> "< object type >" (* TODO *)
|
|
| Some (Other e) -> Odoc_info.string_of_type_expr e
|
|
);
|
|
);
|
|
|
|
|
|
method! scan_module_pre m =
|
|
p fmt "#\n# module %s:\n" m.m_name ;
|
|
if self#must_display_types then
|
|
(
|
|
p fmt "# Odoc_info.string_of_module_type:\n<[%s]>\n"
|
|
(Odoc_info.string_of_module_type m.m_type);
|
|
p fmt "# Odoc_info.string_of_module_type ~complete: true :\n<[%s]>\n"
|
|
(Odoc_info.string_of_module_type ~complete: true m.m_type);
|
|
);
|
|
true
|
|
|
|
method! scan_module_type_pre m =
|
|
p fmt "#\n# module type %s:\n" m.mt_name ;
|
|
if self#must_display_types then
|
|
(
|
|
p fmt "# Odoc_info.string_of_module_type:\n<[%s]>\n"
|
|
(match m.mt_type with
|
|
None -> "None"
|
|
| Some t -> Odoc_info.string_of_module_type t
|
|
);
|
|
p fmt "# Odoc_info.string_of_module_type ~complete: true :\n<[%s]>\n"
|
|
(match m.mt_type with
|
|
None -> "None"
|
|
| Some t -> Odoc_info.string_of_module_type ~complete: true t
|
|
);
|
|
);
|
|
true
|
|
|
|
method generate (module_list: Odoc_info.Module.t_module list) =
|
|
let oc = open_out !Odoc_info.Global.out_file in
|
|
fmt <- Format.formatter_of_out_channel oc;
|
|
(
|
|
try
|
|
List.iter
|
|
(fun m ->
|
|
self#set_test_kinds_from_module m;
|
|
self#scan_module_list [m];
|
|
)
|
|
module_list
|
|
with
|
|
e ->
|
|
prerr_endline (Printexc.to_string e)
|
|
);
|
|
Format.pp_print_flush fmt ();
|
|
close_out oc
|
|
end
|
|
|
|
class generator =
|
|
let g = new string_gen in
|
|
object
|
|
inherit G.generator as base
|
|
|
|
method! generate l =
|
|
base#generate l;
|
|
g#generate l
|
|
end
|
|
end;;
|
|
|
|
let _ = Odoc_args.extend_base_generator (module Generator : Odoc_gen.Base_functor);;
|