List all the available tests on command line

10 files changed, 79 insertions, 12 deletions

diff --git a/bin/args.ml b/bin/args.ml
index 27c5a70..0021b34 100644
--- a/bin/args.ml
+++ b/bin/args.ml
@@ -23,7 +23,7 @@ let level : string -> unit =
       print_endline e;
       exit 1
 
-let speclist =
+let speclist printer =
   let common_arguments =
     [
       ( "--version",
@@ -32,7 +32,15 @@ let speclist =
             Printf.printf "Version %s\n" Tools.Git_hash.revision;
             exit 0),
         "\tDisplay the version of the application and exit" );
-      ("--level", Arg.String level, "\tMessage level [debug, warn, error]");
+      ( "--list-tests",
+        Arg.Unit
+          (fun () ->
+            printer Format.std_formatter;
+            exit 0),
+        "\tPrint all the available tests then exit" );
+      ( "--level",
+        Arg.String level,
+        "\tFilter with this message level [debug, warn, error]" );
       ( "--global",
         Arg.Set reset_line,
         "\tEach line is refered from the begining of the file and not the \
@@ -46,8 +54,9 @@ let speclist =
   in
   common_arguments @ windows_arguments
 
-let parse : unit -> string list * t =
- fun () ->
+let parse : list_tests:(Format.formatter -> unit) -> string list * t =
+ fun ~list_tests ->
+  let speclist = speclist list_tests in
   let () = Arg.parse (Arg.align speclist) anon_fun usage in
 
   match !input_files with
diff --git a/bin/args.mli b/bin/args.mli
index 5231cae..cffd0d0 100644
--- a/bin/args.mli
+++ b/bin/args.mli
@@ -3,4 +3,4 @@ type filters = { level : Qsp_syntax.Report.level option }
 type t = { reset_line : bool; filters : filters }
 (** All the arguments given from the command line *)
 
-val parse : unit -> string list * t
+val parse : list_tests:(Format.formatter -> unit) -> string list * t
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
diff --git a/lib/syntax/S.ml b/lib/syntax/S.ml
index 972e405..a961738 100644
--- a/lib/syntax/S.ml
+++ b/lib/syntax/S.ml
@@ -103,6 +103,9 @@ end
 (** {1 Unified module used by the parser } *)
 
 module type Analyzer = sig
+  val identifier : string
+  val description : string
+
   module Expression : Expression
   module Instruction : Instruction with type expression = Expression.t'
   module Location : Location with type instruction = Instruction.t'
diff --git a/lib/syntax/check.ml b/lib/syntax/check.ml
index a7095fc..59eaaf1 100644
--- a/lib/syntax/check.ml
+++ b/lib/syntax/check.ml
@@ -83,6 +83,9 @@ let build :
   in
   (location_witness, t)
 
+let get_module : t -> (module S.Analyzer) =
+ fun (E { module_; _ }) -> (module_ :> (module S.Analyzer))
+
 module type App = sig
   val t : t array
 end
@@ -105,6 +108,9 @@ module Helper = struct
 end
 
 module Make (A : App) = struct
+  let identifier = "main_checker"
+  let description = "Internal module"
+
   (* Global variable for the whole module *)
   let len = Array.length A.t
 
diff --git a/lib/syntax/check.mli b/lib/syntax/check.mli
index 759a07a..daacf47 100644
--- a/lib/syntax/check.mli
+++ b/lib/syntax/check.mli
@@ -35,6 +35,8 @@ val build :
     Return the result type which hold the final result value, and checker
     itself. *)
 
+val get_module : t -> (module S.Analyzer)
+
 type result
 
 val get : 'a Id.typeid -> result -> 'a option
diff --git a/lib/syntax/dead_end.ml b/lib/syntax/dead_end.ml
index 042e640..bb56b2f 100644
--- a/lib/syntax/dead_end.ml
+++ b/lib/syntax/dead_end.ml
@@ -1,5 +1,8 @@
 open StdLabels
 
+let identifier = "dead_end"
+let description = "Check for dead end in the code"
+
 module Expression = struct
   type t = unit
   type t' = unit
diff --git a/lib/syntax/nested_strings.ml b/lib/syntax/nested_strings.ml
index 9d4867c..37f352c 100644
--- a/lib/syntax/nested_strings.ml
+++ b/lib/syntax/nested_strings.ml
@@ -1,5 +1,8 @@
 open StdLabels
 
+let identifier = "escaped_string"
+let description = "Check for unnecessary use of expression encoded in string"
+
 module Expression : S.Expression with type t' = Report.t list = struct
   type t = Report.t list
   type t' = t
diff --git a/lib/syntax/tree.ml b/lib/syntax/tree.ml
index e70b66a..8444fd9 100644
--- a/lib/syntax/tree.ml
+++ b/lib/syntax/tree.ml
@@ -1,5 +1,8 @@
 open StdLabels
 
+let identifier = "tree"
+let description = "Build the AST"
+
 module Ast = struct
   type 'a literal = 'a T.literal = Text of string | Expression of 'a list
   [@@deriving eq, show]
diff --git a/lib/syntax/type_of.ml b/lib/syntax/type_of.ml
index 8f1c7ef..224e029 100644
--- a/lib/syntax/type_of.ml
+++ b/lib/syntax/type_of.ml
@@ -1,5 +1,8 @@
 open StdLabels
 
+let identifier = "type_check"
+let description = "Ensure all the expression are correctly typed"
+
 module Helper = struct
   type type_of =
     | Integer  (** A numeric value *)