From f21a7b0552f65de232ab75bdd3172c6c182292b1 Mon Sep 17 00:00:00 2001
From: Chimrod <>
Date: Tue, 3 Oct 2023 08:23:59 +0200
Subject: In windows, do not ask the user before terminating

---
 bin/qsp_parser.ml | 63 ++++++++++++++-----------------------------------------
 1 file changed, 16 insertions(+), 47 deletions(-)

(limited to 'bin/qsp_parser.ml')

diff --git a/bin/qsp_parser.ml b/bin/qsp_parser.ml
index 32e7a2f..8fb7189 100644
--- a/bin/qsp_parser.ml
+++ b/bin/qsp_parser.ml
@@ -2,46 +2,9 @@ open StdLabels
 module Report = Qsp_syntax.Report
 
 type result = Report.t list [@@deriving show]
-type filters = { level : Report.level option }
-
-module Args = struct
-  let input_files = ref []
-  let usage = "qsp_parser input_file"
-  let anon_fun filename = input_files := filename :: !input_files
-  let level_value = ref None
-  let reset_line = ref false
-
-  let level : string -> unit =
-   fun str_level ->
-    match Report.level_of_string str_level with
-    | Ok level_ -> level_value := Some level_
-    | Error e ->
-        print_endline e;
-        exit 1
-
-  let speclist =
-    [
-      ( "--version",
-        Arg.Unit
-          (fun () ->
-            Printf.printf "Version %s\n" Tools.Git_hash.revision;
-            exit 0),
-        "Display the version of the application and exit" );
-      ("--level", Arg.String level, "Message level [debug, warn, error]");
-      ( "--global",
-        Arg.Set reset_line,
-        "Each line is refered from the begining of the file and not the \
-         location" );
-    ]
-
-  let parse () =
-    let () = Arg.parse speclist anon_fun usage in
-    let filters = { level = !level_value } in
-    (!input_files, !reset_line, filters)
-end
 
 (** Filter the results given by the analysis *)
-let filter_report : filters -> Report.t list -> Report.t -> Report.t list =
+let filter_report : Args.filters -> Report.t list -> Report.t -> Report.t list =
  fun filters reports r ->
   let is_ok =
     match filters.level with
@@ -54,7 +17,7 @@ let filter_report : filters -> Report.t list -> Report.t -> Report.t list =
 (** Read the source file until getting a report (the whole location has been
     read properly), or until the first syntax error. 
     *)
-let parse_location : Qparser.Lexbuf.t -> filters -> unit =
+let parse_location : Qparser.Lexbuf.t -> Args.filters -> unit =
  fun lexbuf filters ->
   let result = Qparser.Analyzer.parse (module Qsp_syntax.Type_of) lexbuf in
 
@@ -79,30 +42,36 @@ let parse_location : Qparser.Lexbuf.t -> filters -> unit =
         start_position.Lexing.pos_fname Report.pp e
 
 let () =
-  let file_names, reset_line, filters = Args.parse () in
+  let file_names, parameters = Args.parse () in
   let file_name = List.hd file_names in
 
   let ic = Stdlib.open_in_bin file_name in
 
   (*let lexer = Lexing.from_channel ~with_positions:true ic in*)
-  let lexer =
+  let lexer, parameters =
     match Filename.extension file_name with
-    | ".qsrc" -> Sedlexing.Utf8.from_channel ic
-    | ".txt" -> Sedlexing.Utf16.from_channel ic (Some Little_endian)
+    | ".qsrc" ->
+        (* The source file are in UTF-8, and we can use the file line number as
+           we have only a single location. *)
+        (Sedlexing.Utf8.from_channel ic, { parameters with reset_line = false })
+    | ".txt" ->
+        (Sedlexing.Utf16.from_channel ic (Some Little_endian), parameters)
     | _ -> raise (Failure "unknown extension")
   in
-  let lexer = Qparser.Lexbuf.from_lexbuf ~reset_line lexer in
+  let lexer =
+    Qparser.Lexbuf.from_lexbuf ~reset_line:parameters.reset_line lexer
+  in
 
   let () =
     try
       while true do
-        parse_location lexer filters
+        parse_location lexer parameters.filters
       done
     with Qparser.Lexer.EOF -> ()
   in
   let () =
-    match Sys.os_type with
-    | "Win32" ->
+    match parameters.interractive with
+    | true ->
         print_endline "Press <Enter> to terminate";
         ignore @@ read_line ()
     | _ -> ()
-- 
cgit v1.2.3