accept any option through .inferconfig

Summary: Any option accepted by infer/InferAnalyze/... can now appear in .inferconfig and will be interpreted accordingly. Options in .inferconfig are overriden by both env vars parameters and command line arguments. To achieve this, we do a first round of parsing that only acts on the flags necessary to find out where .inferconfig lives. Then we serialise the contents of the json file into the format expected by command-line arguments, and use a trick similar to the way we handle env variables to interpret the json arguments. Reviewed By: jberdine Differential Revision: D3298379 fbshipit-source-id: 12b7d57
9 years ago · 3fe032ccf0
parent 1c56310f39
commit 3fe032ccf0
4 changed files with 99 additions and 39 deletions
--- a/infer/src/backend/CommandLineOption.ml
+++ b/infer/src/backend/CommandLineOption.ml
@ -12,6 +12,7 @@
 open! Utils

 module F = Format
+module YBU = Yojson.Basic.Util


 (* Each command line option may appear in the --help list of any executable, these tags are used to
@ -28,7 +29,11 @@ let current_exe =
  | _ -> T


-type desc = { long: string; short: string; meta: string; doc: string; spec: Arg.spec }
+type desc = {
+  long: string; short: string; meta: string; doc: string; spec: Arg.spec;
+  (** how to go from an option in the json config file to a list of command-line options *)
+  decode_json: Yojson.Basic.json -> string list ;
+}

 let dashdash long =
  match long with
@ -125,7 +130,7 @@ let add exes desc =
    ) exe_desc_lists

 let mk ?(deprecated=[]) ?(exes=[])
-    ~long ?(short="") ~default ~meta doc ~default_to_string ~mk_setter ~mk_spec =
+    ~long ?(short="") ~default ~meta doc ~default_to_string ~decode_json ~mk_setter ~mk_spec =
  let variable = ref default in
  let closure = mk_setter variable in
  let setter str =
@ -136,7 +141,7 @@ let mk ?(deprecated=[]) ?(exes=[])
    let default_string = default_to_string default in
    if default_string = "" then doc
    else doc ^ " (default: " ^ default_string ^ ")" in
-  let desc = {long; short; meta; doc; spec} in
+  let desc = {long; short; meta; doc; spec; decode_json} in
  (* add desc for long option, with documentation (which includes any short option) for exes *)
  add exes desc ;
  (* add desc for short option only for parsing, without documentation *)
@ -153,11 +158,16 @@ type 'a t =
  ?exes:exe list -> ?meta:string -> Arg.doc ->
  'a

+let string_json_decoder ~long json = [dashdash long; YBU.to_string json]
+
+let list_json_decoder json_decoder json = IList.flatten (YBU.convert_each json_decoder json)
+
 let mk_set var value ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
  let setter () = var := value in
  ignore(
    mk ~deprecated ~long ?short ~default:() ?exes ~meta doc
      ~default_to_string:(fun () -> "")
+      ~decode_json:(string_json_decoder ~long)
      ~mk_setter:(fun _ _ -> setter ())
      ~mk_spec:(fun _ -> Arg.Unit setter) )

@ -165,6 +175,7 @@ let mk_option ?(default=None) ?(default_to_string=fun _ -> "") ~f
    ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
  mk ~deprecated ~long ?short ~default ?exes ~meta doc
    ~default_to_string
+    ~decode_json:(string_json_decoder ~long)
    ~mk_setter:(fun var str -> var := f str)
    ~mk_spec:(fun set -> Arg.String set)

@ -199,10 +210,16 @@ let mk_bool ?(deprecated_no=[]) ?(default=false) ?(f=fun b -> b)
  let mk_spec set = Arg.Unit (fun () -> set "") in
  let var =
    mk ~long ?short ~deprecated ~default ?exes
-      ~meta doc ~default_to_string ~mk_setter:(fun var _ -> var := f true) ~mk_spec in
+      ~meta doc ~default_to_string ~mk_setter:(fun var _ -> var := f true)
+      ~decode_json:(fun json ->
+          [dashdash (if YBU.to_bool json then long else nolong)])
+      ~mk_spec in
  ignore(
    mk ~long:nolong ?short:noshort ~deprecated:deprecated_no ~default:(not default) ?exes
-      ~meta nodoc ~default_to_string ~mk_setter:(fun _ _ -> var := f false) ~mk_spec );
+      ~meta nodoc ~default_to_string ~mk_setter:(fun _ _ -> var := f false)
+      ~decode_json:(fun json ->
+          [dashdash (if YBU.to_bool json then nolong else long)])
+      ~mk_spec );
  var

 let mk_bool_group ?(deprecated_no=[]) ?(default=false)
@ -217,18 +234,21 @@ let mk_int ~default ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
  mk ~deprecated ~long ?short ~default ?exes ~meta doc
    ~default_to_string:string_of_int
    ~mk_setter:(fun var str -> var := (int_of_string str))
+    ~decode_json:(string_json_decoder ~long)
    ~mk_spec:(fun set -> Arg.String set)

 let mk_float ~default ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
  mk ~deprecated ~long ?short ~default ?exes ~meta doc
    ~default_to_string:string_of_float
    ~mk_setter:(fun var str -> var := (float_of_string str))
+    ~decode_json:(string_json_decoder ~long)
    ~mk_spec:(fun set -> Arg.String set)

 let mk_string ~default ?(f=fun s -> s) ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
  mk ~deprecated ~long ?short ~default ?exes ~meta doc
    ~default_to_string:(fun s -> s)
    ~mk_setter:(fun var str -> var := f str)
+    ~decode_json:(string_json_decoder ~long)
    ~mk_spec:(fun set -> Arg.String set)

 let mk_string_opt ?default ?(f=fun s -> s) ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
@ -241,6 +261,7 @@ let mk_string_list ?(default=[]) ?(f=fun s -> s)
  mk ~deprecated ~long ?short ~default ?exes ~meta doc
    ~default_to_string:(String.concat ", ")
    ~mk_setter:(fun var str -> var := (f str) :: !var)
+    ~decode_json:(list_json_decoder (string_json_decoder ~long))
    ~mk_spec:(fun set -> Arg.String set)

 let mk_symbol ~default ~symbols ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
@ -251,6 +272,7 @@ let mk_symbol ~default ~symbols ?(deprecated=[]) ~long ?short ?exes ?(meta="") d
  mk ~deprecated ~long ?short ~default ?exes ~meta doc
    ~default_to_string:(fun s -> to_string s)
    ~mk_setter:(fun var str -> var := of_string str)
+    ~decode_json:(string_json_decoder ~long)
    ~mk_spec:(fun set -> Arg.Symbol (strings, set))

 let mk_symbol_opt ~symbols ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
@ -259,6 +281,7 @@ let mk_symbol_opt ~symbols ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
  mk ~deprecated ~long ?short ~default:None ?exes ~meta doc
    ~default_to_string:(fun _ -> "")
    ~mk_setter:(fun var str -> var := Some (of_string str))
+    ~decode_json:(string_json_decoder ~long)
    ~mk_spec:(fun set -> Arg.Symbol (strings, set))

 let mk_symbol_seq ?(default=[]) ~symbols ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
@ -269,6 +292,9 @@ let mk_symbol_seq ?(default=[]) ~symbols ?(deprecated=[]) ~long ?short ?exes ?(m
    ~default_to_string:(fun syms -> String.concat " " (IList.map to_string syms))
    ~mk_setter:(fun var str_seq ->
        var := IList.map of_string (Str.split (Str.regexp_string ",") str_seq))
+    ~decode_json:(fun json ->
+        [dashdash long;
+         String.concat "," (YBU.convert_each YBU.to_string json)])
    ~mk_spec:(fun set -> Arg.String set)

 let anon_fun = ref (fun arg -> raise (Arg.Bad ("unexpected anonymous argument: " ^ arg)))
@ -279,6 +305,38 @@ let mk_anon () =
  anon


+(* begin temporarily export inferconfig_json while .inferconfig-specific options still exist *)
+let inferconfig_json = ref (`Assoc [])
+(* end temporarily export inferconfig_json *)
+
+let decode_inferconfig_to_argv path =
+  let json = match read_optional_json_file path with
+    | Ok json ->
+        (* begin temporarily export inferconfig_json while
+           .inferconfig-specific options still exist *)
+        inferconfig_json := json ;
+        (* end temporarily export inferconfig_json *)
+        json
+    | Error msg ->
+        F.eprintf "WARNING: Could not read or parse Infer config in %s:@\n%s@." path msg ;
+        `Assoc [] in
+  let desc_list = !(IList.assoc ( = ) current_exe exe_desc_lists) in
+  let json_config = YBU.to_assoc json in
+  let one_config_item result (key, json_val) =
+    try
+      let {decode_json} = IList.find (fun {long} -> string_equal key long) desc_list in
+      decode_json json_val @ result
+    with
+    | Not_found ->
+        (* TODO: have all json options be regular options as well. When this is done, we can show a
+           warning if a json key is not a valid option. *)
+        result
+    | YBU.Type_error (msg, json) ->
+        F.eprintf "WARNING: while reading config file %s:@\nIll-formed value %s for option %s: %s@."
+          path (Yojson.Basic.to_string json) key msg ;
+        result in
+  IList.fold_left one_config_item [] json_config
+

 (** [sep_char] is used to separate elements of argv when encoded into environment variables *)
 let sep_char = '^'
@ -308,7 +366,7 @@ let prefix_before_rest args =
  prefix_before_rest_ [] args


-let parse ?(incomplete=false) env_var exe_usage =
+let parse ?(incomplete=false) ?config_file env_var exe_usage =
  let curr_speclist = ref []
  and full_speclist = ref []
  in
@ -322,12 +380,15 @@ let parse ?(incomplete=false) env_var exe_usage =
    exit status
  in
  let help_desc_list =
-    [ { long = "help"; short = ""; meta = ""; spec = Arg.Unit (fun () -> curr_usage 0);
+    [ { long = "help"; short = ""; meta = ""; decode_json = (fun _ -> []);
+        spec = Arg.Unit (fun () -> curr_usage 0);
        doc = "Display this list of options" }
-    ; { long = "help-full"; short = ""; meta = ""; spec = Arg.Unit (fun () -> full_usage 0);
+    ; { long = "help-full"; short = ""; meta = ""; decode_json = (fun _ -> []);
+        spec = Arg.Unit (fun () -> full_usage 0);
        doc = "Display the full list of options, including internal and experimental options" }
    ] in
-  let section heading speclist =
+  let normalize speclist =
+    let speclist = help_desc_list @ speclist in
    let norm k =
      let len = String.length k in
      if len > 3 && String.sub k 0 3 = "no-" then String.sub k 3 (len - 3) else k in
@ -338,27 +399,20 @@ let parse ?(incomplete=false) env_var exe_usage =
      | _, "--" -> -1
      | _ -> String.compare (norm x) (norm y) in
    let sort speclist = IList.sort compare_specs speclist in
-    let add_heading speclist =
-      match heading with
-      | Some heading ->
-          let doc = "\n  " ^ heading ^ "\n" in
-          { doc; long = ""; short = ""; meta = ""; spec = Arg.Unit (fun () -> ()) } :: speclist
-      | None ->
-          speclist in
    let suppress_help speclist =
      ("-help", Arg.Unit (fun () -> raise (Arg.Bad "unknown option '-help'")), "") :: speclist in
-    suppress_help (align ~limit:32 (add_heading (sort speclist)))
+    suppress_help (align ~limit:32 (sort speclist))
  in
  let curr_desc_list = IList.assoc ( = ) current_exe exe_desc_lists
  in
  (* curr_speclist includes args for current exe with docs, and all other args without docs, so
     that all args can be parsed, but --help and parse failures only show external args for
     current exe *)
-  curr_speclist := (section None (help_desc_list @ !curr_desc_list))
+  curr_speclist := normalize !curr_desc_list
  ;
  assert( check_no_duplicates !curr_speclist )
  ;
-  full_speclist := (section None (help_desc_list @ !full_desc_list))
+  full_speclist := normalize !full_desc_list
  ;
  let env_args = decode_env_to_argv (try Unix.getenv env_var with Not_found -> "") in
  (* begin transitional support for INFERCLANG_ARGS *)
@ -368,10 +422,16 @@ let parse ?(incomplete=false) env_var exe_usage =
  let env_args = c_args @ env_args in
  (* end transitional support for INFERCLANG_ARGS *)
  let exe_name, env_cl_args = prepend_to_argv env_args in
+  let all_args = match config_file with
+    | None -> env_cl_args
+    | Some path ->
+        let json_args = decode_inferconfig_to_argv path in
+        (* read .inferconfig first, as both env vars and command-line options overwrite it *)
+        json_args @ env_cl_args in
  let current = ref 0 in
  let rec parse_loop () =
    try
-      Arg.parse_argv_dynamic ~current (Array.of_list (exe_name :: env_cl_args))
+      Arg.parse_argv_dynamic ~current (Array.of_list (exe_name :: all_args))
        curr_speclist !anon_fun usage_msg
    with
    | Arg.Bad _ when incomplete -> parse_loop ()
@ -380,5 +440,5 @@ let parse ?(incomplete=false) env_var exe_usage =
  in
  parse_loop () ;
  if not incomplete then
-    Unix.putenv env_var (encode_argv_to_env (prefix_before_rest env_cl_args)) ;
+    Unix.putenv env_var (encode_argv_to_env (prefix_before_rest all_args)) ;
  curr_usage
--- a/infer/src/backend/CommandLineOption.mli
+++ b/infer/src/backend/CommandLineOption.mli
@ -11,6 +11,10 @@

 open! Utils

+(* begin temporarily export inferconfig_json while .inferconfig-specific options still exist *)
+val inferconfig_json : Yojson.Basic.json ref
+(* end temporarily export inferconfig_json *)
+
 type exe = A | C | J | L | P | T

 val current_exe : exe
@ -89,8 +93,11 @@ val mk_anon :

 (** [parse env_var exe_usage] parses command line arguments as specified by preceding calls to the
    [mk_*] functions, and returns a function that prints the usage message and help text then exits.
-    The decoded value of environment variable [env_var] is prepended to [Sys.argv] before parsing.
-    Therefore arguments passed on the command line supercede those specified in the environment
-    variable.  WARNING: If an argument appears both in the environment variable and on the command
-    line, it will be interpreted twice. *)
-val parse : ?incomplete:bool -> string -> (exe -> Arg.usage_msg) -> (int -> 'a)
+    The decoded values of the inferconfig file [config_file], if provided, and of the environment
+    variable [env_var] are prepended to [Sys.argv] before parsing.  Therefore arguments passed on
+    the command line supersede those specified in the environment variable, which themselves
+    supersede those passed via the config file.  WARNING: An argument will be interpreted as many
+    times as it appears in all of the config file, the environment variable, and the command
+    line. *)
+val parse : ?incomplete:bool -> ?config_file:string ->
+  string -> (exe -> Arg.usage_msg) -> (int -> 'a)
--- a/infer/src/backend/config.ml
+++ b/infer/src/backend/config.ml
@ -952,7 +952,7 @@ let post_parsing_initialization () =


 let parse_args_and_return_usage_exit =
-  let usage_exit = CLOpt.parse "INFER_ARGS" exe_usage in
+  let usage_exit = CLOpt.parse ~config_file:inferconfig_path "INFER_ARGS" exe_usage in
  if !debug || (!developer_mode && not (CLOpt.current_exe = CLOpt.P)) then
    prerr_endline
      ((Filename.basename Sys.executable_name) ^ " got args "
@ -1055,22 +1055,15 @@ and write_html = !write_html
 and xml_specs = !xml_specs
 and zip_libraries = !zip_libraries

-let inferconfig_json =
-  lazy (
-    match read_optional_json_file inferconfig_path with
-    | Ok json -> json
-    | Error msg ->
-        F.fprintf F.err_formatter "Could not read or parse Infer config in %s:@\n%s@."
-          inferconfig_path msg;
-        exit 1)
+let inferconfig_json = lazy !CLOpt.inferconfig_json

 and suppress_warnings_json = lazy (
  let error msg =
-    F.fprintf F.err_formatter "There was an issue reading the option %s.@\n"
+    F.eprintf "There was an issue reading the option %s.@\n"
      suppress_warnings_annotations_long ;
-    F.fprintf F.err_formatter "If you did not call %s directly, this is likely a bug in Infer.@\n"
+    F.eprintf "If you did not call %s directly, this is likely a bug in Infer.@\n"
      (Filename.basename Sys.executable_name) ;
-    F.fprintf F.err_formatter "%s@." msg ;
+    F.eprintf "%s@." msg ;
    exit 1 in
  match !suppress_warnings_out with
  | Some path -> (
--- a/infer/src/backend/inferprint.ml
+++ b/infer/src/backend/inferprint.ml
@ -823,7 +823,7 @@ module AnalysisResults = struct
    (* find spec files specified by command-line arguments *)
    IList.iter (fun arg ->
        if not (Filename.check_suffix arg Config.specs_files_suffix) && arg <> "."
-        then print_usage_exit "arguments must be .specs files"
+        then print_usage_exit ("file "^ arg ^ ": arguments must be .specs files")
      ) Config.anon_args ;
    (match Config.source_file_copy with
     | Some s -> source_file_copy := Some (DB.abs_source_file_from_path s)