module S = Qsp_syntax.S

type pos = S.pos

let pp_pos = Qsp_syntax.Report.pp_pos
let equal_pos : pos -> pos -> bool = fun _ _ -> true

type t = Qsp_syntax.Report.t = {
  level : Qsp_syntax.Report.level;
  loc : pos;
  message : string;
}
[@@deriving show, eq]

let report : t list Alcotest.testable =
  Alcotest.list @@ Alcotest.testable Qsp_syntax.Report.pp equal

let report_global : (string * t) list Alcotest.testable =
  Alcotest.list
  @@ Alcotest.pair Alcotest.string
       (Alcotest.testable Qsp_syntax.Report.pp equal)

(** Build a parser for a specific check module *)
module M
    (Checkable : Qsp_syntax.Analyzer.T with type ex = Qsp_syntax.Identifier.t) =
struct
  let context_id = Type.Id.make ()

  (* Build the test module with a single test inside. *)
  module Check = Qsp_checks.Check.Make (struct
    let t = [| Qsp_syntax.Identifier.build ~context_id (module Checkable) |]
  end)

  let _parse :
      ?context:Checkable.context ->
      Qparser.Analyzer.lexer ->
      string ->
      (Check.Location.t Qparser.Analyzer.result, t) result =
   fun ?context lexer content ->
    let lexing =
      Sedlexing.Latin1.from_string content |> Qparser.Lexbuf.from_lexbuf
    in
    (* Initialize the context *inside* the Check module. This works by
       editing the context we created.

       We have the context id (created at the begining of the module), which is
       required to get the value. *)
    let context =
      match context with
      | None -> Check.initialize ()
      | Some c -> (
          let init = Check.initialize () in
          match Qsp_checks.Check.set context_id init.(0) c with
          | None -> raise Not_found
          | Some v ->
              init.(0) <- v;
              init)
    in
    Qparser.Analyzer.parse (module Check) lexer lexing context

  let get_report :
      (Check.Location.t Qparser.Analyzer.result, Qsp_syntax.Report.t) result ->
      Qsp_syntax.Report.t list = function
    | Ok v -> v.report
    | Error msg -> failwith msg.message

  let _test_instruction : string -> t list -> unit =
   fun literal expected ->
    let actual = get_report @@ _parse Qparser.Analyzer.Dynamic literal
    and msg = literal in

    Alcotest.(check' report ~msg ~expected ~actual)

  (** Run a test over the whole file. The parsing of the content shall not
      report any error. *)
  let global_check : string -> (string * t) list -> unit =
   fun literal expected ->
    let _location = Printf.sprintf {|# Location
%s
------- |} literal in
    let context = Checkable.initialize () in
    let actual =
      get_report @@ _parse ~context Qparser.Analyzer.Location _location
    in
    let () =
      Alcotest.(
        check' report ~msg:"Error reported during parsing" ~expected:[] ~actual)
    in
    let msg = literal in
    let actual = Checkable.finalize context in
    Alcotest.(check' report_global ~msg ~expected ~actual)
end