open StdLabels

(** 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);
  ]

(** 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 get_report :
    (module Qsp_syntax.Analyzer.T
       with type context = Qsp_checks.Check.result array) ->
    Qsp_checks.Check.result array ->
    Qparser.Lexbuf.t ->
    (Qsp_syntax.Report.t list, Qsp_syntax.Report.t) result =
 fun (module Check) context lexbuf ->
  let result =
    Qparser.Analyzer.parse
      (module Check)
      Qparser.Analyzer.Location lexbuf context
  in

  (* Also analyse eache dynamic string identified in the module *)
  Result.map
    (fun r ->
      let found_report =
        Array.find_map context ~f:(fun value ->
            Qsp_checks.Check.get dynamic_context_id value)
      in

      match found_report 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