diff options
| -rw-r--r-- | bin/args.ml | 58 | ||||
| -rw-r--r-- | bin/args.mli | 6 | ||||
| -rw-r--r-- | bin/qsp_parser.ml | 63 |
3 files changed, 80 insertions, 47 deletions
diff --git a/bin/args.ml b/bin/args.ml new file mode 100644 index 0000000..e4e892c --- /dev/null +++ b/bin/args.ml @@ -0,0 +1,58 @@ +module Report = Qsp_syntax.Report + +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 interractive = ref true + +type filters = { level : Report.level option } + +type t = { reset_line : bool; filters : filters; interractive : bool } +(** All the arguments given from the command line *) + +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 = + let common_arguments = + [ + ( "--version", + Arg.Unit + (fun () -> + 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]"); + ( "--global", + Arg.Set reset_line, + "\tEach line is refered from the begining of the file and not the \ + location" ); + ] + and windows_arguments = + match Sys.os_type with + | "Win32" -> + [ + ( "--no-prompt", + Arg.Clear interractive, + "\tDo not ask the user to press enter after processing the source" + ); + ] + | _ -> + interractive := false; + [] + in + common_arguments @ windows_arguments + +let parse : unit -> string list * t = + fun () -> + let () = Arg.parse (Arg.align speclist) anon_fun usage in + let filters = { level = !level_value } in + ( !input_files, + { reset_line = !reset_line; filters; interractive = !interractive } ) diff --git a/bin/args.mli b/bin/args.mli new file mode 100644 index 0000000..1a063fc --- /dev/null +++ b/bin/args.mli @@ -0,0 +1,6 @@ +type filters = { level : Qsp_syntax.Report.level option } + +type t = { reset_line : bool; filters : filters; interractive : bool } +(** All the arguments given from the command line *) + +val parse : unit -> string list * t 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 () | _ -> () |