Added a lsp server

1 files changed, 6 insertions, 83 deletions

diff --git a/bin/qsp_parser.ml b/bin/qsp_parser.ml
index 7ec3eff..f389406 100644
--- a/bin/qsp_parser.ml
+++ b/bin/qsp_parser.ml
@@ -18,25 +18,6 @@ module type T = sig
   include module type of Qsp_checks.Dynamics
 end
 
-(** Witness used to extract the values in the module Qsp_checks.Dynamics during
-    the parsing. *)
-let dynamic_context_id : Qsp_checks.Dynamics.context Type.Id.t = Type.Id.make ()
-
-(*
-    List all the controls to apply 
- *)
-let available_checks =
-  [
-    Qsp_syntax.Identifier.build ~context_id:dynamic_context_id
-      (module Qsp_checks.Dynamics);
-    Qsp_syntax.Identifier.build (module Qsp_checks.Type_of);
-    Qsp_syntax.Identifier.build (module Qsp_checks.Dead_end);
-    Qsp_syntax.Identifier.build (module Qsp_checks.Nested_strings);
-    Qsp_syntax.Identifier.build (module Qsp_checks.Locations);
-    Qsp_syntax.Identifier.build (module Qsp_checks.Dup_test);
-    Qsp_syntax.Identifier.build (module Qsp_checks.Write_only);
-  ]
-
 let pp_module formatter (module A : Qsp_syntax.Analyzer.T) =
   Format.fprintf formatter "%s" A.identifier;
   Format.pp_print_tab formatter ();
@@ -50,7 +31,7 @@ let pp_module formatter (module A : Qsp_syntax.Analyzer.T) =
 (** Print all the available modules *)
 let pp_modules formatter =
   let max_length =
-    List.fold_left available_checks ~init:0 ~f:(fun l v ->
+    List.fold_left Checklist.available_checks ~init:0 ~f:(fun l v ->
         let (module A : Qsp_syntax.Analyzer.T) =
           Qsp_syntax.Identifier.get_module v
         in
@@ -74,30 +55,10 @@ let pp_modules formatter =
          let m = Qsp_syntax.Identifier.get_module v in
          pp_module f m)
        ~pp_sep:(fun f () -> Format.pp_force_newline f ()))
-    available_checks;
+    Checklist.available_checks;
   Format.pp_close_tbox formatter ();
   Format.pp_print_break formatter 0 0
 
-(** Get all the tests to apply.
-
-    The expression is declared lazy in order to be sure to apply the filters
-    from the command line before. *)
-let checkers :
-    (module Qsp_syntax.Analyzer.T
-       with type context = Qsp_checks.Check.result array)
-    Lazy.t =
-  lazy
-    (let module Check = Qsp_checks.Check.Make (struct
-       let t =
-         List.filter available_checks ~f:(fun v ->
-             let (module A : Qsp_syntax.Analyzer.T) =
-               Qsp_syntax.Identifier.get_module v
-             in
-             !A.active)
-         |> Array.of_list
-     end) in
-    (module Check))
-
 let pp_report :
     (Format.formatter -> 'a -> unit) ->
     Qparser.Lexbuf.t ->
@@ -151,52 +112,14 @@ let parse_location :
     Args.filters ->
     unit =
  fun ~ctx (module Check) context lexbuf filters ->
-  let result =
-    Qparser.Analyzer.parse
-      (module Check)
-      Qparser.Analyzer.Location lexbuf context
-  in
-
-  (* Also analyse eache dynamic string identified in the module *)
   let result_with_dynamics =
-    Result.map
-      (fun r ->
-        match Qsp_checks.Check.get dynamic_context_id (Array.get context 0) with
-        | None -> r.Qparser.Analyzer.report
-        | Some dyn_context ->
-            let seq : Qsp_checks.Dynamics.text Seq.t =
-              Qsp_checks.Dynamics.dynamics_string dyn_context
-            in
-            Seq.fold_left
-              (fun r content ->
-                let text = content.Qsp_checks.Dynamics.content ^ "\n" in
-
-                let lexing =
-                  Sedlexing.Latin1.from_string text
-                  |> Qparser.Lexbuf.from_lexbuf
-                       ~position:(fst content.Qsp_checks.Dynamics.position)
-                in
-
-                let dyn_report =
-                  Qparser.Analyzer.parse
-                    (module Check)
-                    Qparser.Analyzer.Dynamic lexing context
-                in
-                match dyn_report with
-                | Error e ->
-                    (* Syntax error are not blocking here, but are transformed
-                       into check error *)
-                    e :: r
-                | Ok dyn_ok_reports ->
-                    dyn_ok_reports.Qparser.Analyzer.report @ r)
-              r.Qparser.Analyzer.report seq)
-      result
+    Checklist.get_report (module Check) context lexbuf
   in
   display_result ~ctx lexbuf filters result_with_dynamics
 
 let () =
   let file_names, parameters =
-    Args.parse ~modules:available_checks ~list_tests:pp_modules
+    Args.parse ~modules:Checklist.available_checks ~list_tests:pp_modules
   in
   let file_name =
     List.filter ~f:(fun name -> name.[0] != '+') file_names |> List.hd
@@ -209,7 +132,7 @@ let () =
     match Filename.extension file_name with
     | ".qsrc" ->
         (* Deactivate the tests which only applies to a global file *)
-        List.iter available_checks ~f:(fun t ->
+        List.iter Checklist.available_checks ~f:(fun t ->
             let (module C : Qsp_syntax.Analyzer.T) =
               Qsp_syntax.Identifier.get_module t
             in
@@ -231,7 +154,7 @@ let () =
   in
 
   (* Initialize all the checkers before parsing the source *)
-  let (module Check) = Lazy.force checkers in
+  let (module Check) = Lazy.force Checklist.checkers in
   let check_context = Check.initialize () in
   let ctx =
     ref { error_nb = 0; warn_nb = 0; debug_nb = 0; fatal_error = false }