aboutsummaryrefslogtreecommitdiff
path: root/bin/qsp_parser.ml
diff options
context:
space:
mode:
Diffstat (limited to 'bin/qsp_parser.ml')
-rw-r--r--bin/qsp_parser.ml49
1 files changed, 42 insertions, 7 deletions
diff --git a/bin/qsp_parser.ml b/bin/qsp_parser.ml
index f147a95..db07c82 100644
--- a/bin/qsp_parser.ml
+++ b/bin/qsp_parser.ml
@@ -17,13 +17,48 @@ type ctx = { error_nb : int; warn_nb : int; debug_nb : int }
(*
List all the controls to apply
*)
+let available_checks =
+ [|
+ snd @@ Qsp_syntax.Check.build (module Qsp_syntax.Type_of);
+ snd @@ Qsp_syntax.Check.build (module Qsp_syntax.Dead_end);
+ snd @@ Qsp_syntax.Check.build (module Qsp_syntax.Nested_strings);
+ |]
+
+let pp_print_module formatter (module A : Qsp_syntax.S.Analyzer) =
+ Format.fprintf formatter "%s" A.identifier;
+ Format.pp_print_tab formatter ();
+ Format.fprintf formatter "%s" A.description;
+ ()
+
+let pp_print_modules formatter =
+ let max_length =
+ Array.fold_left available_checks ~init:0 ~f:(fun l v ->
+ let (module A : Qsp_syntax.S.Analyzer) =
+ Qsp_syntax.Check.get_module v
+ in
+ max l (String.length A.identifier))
+ in
+
+ let ll = Array.to_list available_checks in
+ Format.pp_open_tbox formatter ();
+
+ (* Print the name, left justified, with enougth spaces for the identifier *)
+ Format.fprintf formatter "%-*s" (max_length + 1) "Name";
+ Format.pp_set_tab formatter ();
+ Format.fprintf formatter "Description@\n";
+
+ Format.fprintf formatter "%a"
+ (Format.pp_print_list
+ (fun f v ->
+ let m = Qsp_syntax.Check.get_module v in
+ pp_print_module f m)
+ ~pp_sep:(fun f () -> Format.pp_force_newline f ()))
+ ll;
+ Format.pp_close_tbox formatter ();
+ Format.pp_print_break formatter 0 0
+
module Check = Qsp_syntax.Check.Make (struct
- let t =
- [|
- snd @@ Qsp_syntax.Check.build (module Qsp_syntax.Type_of);
- snd @@ Qsp_syntax.Check.build (module Qsp_syntax.Dead_end);
- snd @@ Qsp_syntax.Check.build (module Qsp_syntax.Nested_strings);
- |]
+ let t = available_checks
end)
(** Read the source file until getting a report (the whole location has been
@@ -61,7 +96,7 @@ let parse_location : ctx:ctx -> Qparser.Lexbuf.t -> Args.filters -> ctx =
let default_ctx = { error_nb = 0; warn_nb = 0; debug_nb = 0 }
let () =
- let file_names, parameters = Args.parse () in
+ let file_names, parameters = Args.parse ~list_tests:pp_print_modules in
let file_name = List.hd file_names in
let ic = Stdlib.open_in_bin file_name in