aboutsummaryrefslogtreecommitdiff
path: root/bin/args.ml
blob: 0021b348aac4e69c6fd62cdbdfd18dfeb00d1b22 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
module Report = Qsp_syntax.Report

let input_files = ref []

let usage =
  Printf.sprintf "%s input_file" (Filename.basename Sys.executable_name)

let anon_fun filename = input_files := filename :: !input_files
let level_value = ref None
let reset_line = ref false
let interractive () = ()

type filters = { level : Report.level option }

type t = { reset_line : bool; filters : filters }
(** 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 printer =
  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" );
      ( "--list-tests",
        Arg.Unit
          (fun () ->
            printer Format.std_formatter;
            exit 0),
        "\tPrint all the available tests then exit" );
      ( "--level",
        Arg.String level,
        "\tFilter with this message 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.Unit interractive, "\tDeprecated. Does nothing") ]
    | _ -> []
  in
  common_arguments @ windows_arguments

let parse : list_tests:(Format.formatter -> unit) -> string list * t =
 fun ~list_tests ->
  let speclist = speclist list_tests in
  let () = Arg.parse (Arg.align speclist) anon_fun usage in

  match !input_files with
  | [] ->
      Arg.usage (Arg.align speclist) usage;
      prerr_endline "";
      prerr_endline "Error, you should provide at least one file to parse.";

      exit 1
  | _ ->
      let filters = { level = !level_value } in
      (!input_files, { reset_line = !reset_line; filters })