Refactor cli internals

src/config/config.ml

@@ -0,0 +1,231 @@
+(***************************************************************************)
+(*                                                                         *)
+(*   Copyright (c) 2014-2025 LexiFi SAS. All rights reserved.              *)
+(*                                                                         *)
+(*   This source code is licensed under the MIT License                    *)
+(*   found in the LICENSE file at the root of this source tree             *)
+(*                                                                         *)
+(***************************************************************************)
+
+module Sections = Sections
+
+let must_report_section = Sections.must_report_section
+
+let has_activated = Sections.has_activated
+
+let must_report_call_sites = Sections.must_report_call_sites
+
+let get_main_threshold = Sections.get_main_threshold
+
+type t =
+  { verbose : bool
+  ; internal : bool
+  ; underscore : bool
+  ; paths_to_analyze : Utils.StringSet.t
+  ; excluded_paths : Utils.StringSet.t
+  ; references_paths : Utils.StringSet.t
+  ; sections : Sections.t
+  }
+
+let default_config =
+  { verbose = false
+  ; internal = false
+  ; underscore = false
+  ; paths_to_analyze = Utils.StringSet.empty
+  ; excluded_paths = Utils.StringSet.empty
+  ; references_paths = Utils.StringSet.empty
+  ; sections = Sections.default
+  }
+
+let must_report_main config =
+  let sections = config.sections in
+  has_activated [sections.exported_values; sections.methods; sections.types]
+
+let must_report_opt_args config =
+  let sections = config.sections in
+  has_activated [sections.opta; sections.optn]
+
+let update_exported_values arg config =
+  let sections = Sections.update_exported_values arg config.sections in
+  {config with sections}
+
+let update_methods arg config =
+  let sections = Sections.update_methods arg config.sections in
+  {config with sections}
+
+let update_types arg config =
+  let sections = Sections.update_types arg config.sections in
+  {config with sections}
+
+let update_opta arg config =
+  let sections = Sections.update_opta arg config.sections in
+  {config with sections}
+
+let update_optn arg config =
+  let sections = Sections.update_optn arg config.sections in
+  {config with sections}
+
+let update_style arg config =
+  let sections = Sections.update_style arg config.sections in
+  {config with sections}
+
+let set_verbose config = {config with verbose = true}
+
+(* Print name starting with '_' *)
+let set_underscore config = {config with underscore = true}
+
+let set_internal config = {config with internal = true}
+
+
+let normalize_path path =
+  (* remove redundant "." and consecutive dir_sep in path.
+     E.g. "./foo//bar/./baz" becomes "foo/bar/baz" *)
+  let split_path path =
+    let is_end_of_path path =
+      String.equal path Filename.current_dir_name
+      || String.equal path (Filename.dirname path)
+    in
+    let rec split_path path =
+      if is_end_of_path path then [path]
+      else
+        let splitted_dirpath = split_path (Filename.dirname path) in
+        (Filename.basename path) :: splitted_dirpath
+    in
+    List.rev (split_path path)
+  in
+  let remove_redundancies splitted_path =
+    let reject_empty_and_curr s =
+      String.equal s "" || String.equal s Filename.current_dir_name
+    in
+    List.filter reject_empty_and_curr splitted_path
+  in
+  let concat_path splitted_path =
+    String.concat Filename.dir_sep splitted_path
+  in
+  match path |> split_path |> remove_redundancies |> concat_path with
+  | "" -> Filename.current_dir_name
+  | normalized_path -> normalized_path
+
+let exclude path config =
+  let path = normalize_path path in
+  let excluded_paths = Utils.StringSet.add path config.excluded_paths in
+  {config with excluded_paths}
+
+let is_excluded path config =
+  let path = normalize_path path in
+  Utils.StringSet.mem path config.excluded_paths
+
+let add_reference_path path config =
+  let references_paths = Utils.StringSet.add path config.references_paths in
+  {config with references_paths}
+
+let add_path_to_analyze path config =
+  let paths_to_analyze = Utils.StringSet.add path config.paths_to_analyze in
+  {config with paths_to_analyze}
+
+(* Command line parsing *)
+let parse_cli () =
+  let config = ref default_config in
+  let update_config f x = config := f x !config in
+  let update_config_unit f () = config := f !config in
+
+  let update_all arg config =
+    config
+    |> update_style ((if arg = "all" then "+" else "-") ^ "all")
+    |> update_exported_values arg
+    |> update_methods arg
+    |> update_types arg
+    |> update_opta arg
+    |> update_optn arg
+  in
+
+  Arg.(parse
+    [ "--exclude",
+        String (update_config exclude),
+        "<path>  Exclude given path from research."
+
+    ; "--references",
+        String (update_config add_reference_path),
+        "<path>  Consider given path to collect references."
+
+    ; "--underscore",
+        Unit (update_config_unit set_underscore),
+        " Show names starting with an underscore"
+
+    ; "--verbose",
+        Unit (update_config_unit set_verbose),
+        " Verbose mode (ie., show scanned files)"
+    ; "-v", Unit (update_config_unit set_verbose), " See --verbose"
+
+    ; "--internal",
+        Unit (update_config_unit set_internal),
+        " Keep internal uses as exported values uses when the interface is given. \
+          This is the default behaviour when only the implementation is found"
+
+    ; "--nothing",
+        Unit (update_config_unit (update_all "nothing")),
+        " Disable all warnings"
+    ; "-a", Unit (update_config_unit (update_all "nothing")), " See --nothing"
+
+    ; "--all",
+        Unit (update_config_unit (update_all "all")),
+        " Enable all warnings"
+    ; "-A", Unit (update_config_unit (update_all "all")), " See --all"
+
+    ; "-E",
+        String (update_config update_exported_values),
+        "<display>  Enable/Disable unused exported values warnings.\n    \
+        <display> can be:\n\
+          \tall\n\
+          \tnothing\n\
+          \t\"threshold:<integer>\": report elements used up to the given integer\n\
+          \t\"calls:<integer>\": like threshold + show call sites"
+
+    ; "-M",
+        String (update_config update_methods),
+        "<display>  Enable/Disable unused methods warnings.\n    \
+        See option -E for the syntax of <display>"
+
+    ; "-Oa",
+        String (update_config update_opta),
+        "<display>  Enable/Disable optional arguments always used warnings.\n    \
+        <display> can be:\n\
+          \tall\n\
+          \tnothing\n\
+          \t<threshold>\n\
+          \t\"calls:<threshold>\" like <threshold> + show call sites\n    \
+        <threshold> can be:\n\
+          \t\"both:<integer>,<float>\": both the number max of exceptions \
+          (given through the integer) and the percent of valid cases (given as a float) \
+          must be respected for the element to be reported\n\
+          \t\"percent:<float>\": percent of valid cases to be reported"
+
+    ; "-On",
+        String (update_config update_optn),
+        "<display>  Enable/Disable optional arguments never used warnings.\n    \
+        See option -Oa for the syntax of <display>"
+
+    ; "-S",
+        String (update_config update_style),
+        " Enable/Disable coding style warnings.\n    \
+        Delimiters '+' and '-' determine if the following option is to enable or disable.\n    \
+        Options (can be used together):\n\
+          \tbind: useless binding\n\
+          \topt: optional arg in arg\n\
+          \tseq: use sequence\n\
+          \tunit: unit pattern\n\
+          \tall: bind & opt & seq & unit"
+
+    ; "-T",
+        String (update_config update_types),
+        "<display>  Enable/Disable unused constructors/records fields warnings.\n    \
+        See option -E for the syntax of <display>"
+
+    ]
+    (
+      update_config add_path_to_analyze
+    )
+    ("Usage: " ^ Sys.argv.(0) ^ " <options> <path>\nOptions are:")
+  );
+
+  !config

src/config/config.mli

@@ -0,0 +1,57 @@
+(** Configuration of the analyzer *)
+
+(** {2 Sections configuration} *)
+
+module Sections = Sections
+
+val must_report_section : _ Sections.section -> bool
+(** [must_report_section sec] returns `true` if the section must be reported *)
+
+val must_report_call_sites : _ Sections.section -> bool
+(** [must_report_call_sites sec] returns `true` if call sites must be reported in
+    thresholded subsections *)
+
+val get_main_threshold : Sections.main_section -> int
+(** [get_main_threshold main_sec] returns the threshold if
+    [main_sec = Threshold _], [0] otherwise. *)
+
+(** {2 General configuration} *)
+
+type t = private
+  { verbose : bool (** Display additional information during the analaysis *)
+  ; internal : bool (** Keep track of internal uses for exported values *)
+  ; underscore : bool (** Keep track of elements with names starting with [_] *)
+  ; paths_to_analyze : Utils.StringSet.t
+      (** Paths found in the command line and considered for analysis *)
+  ; excluded_paths : Utils.StringSet.t (** Paths to exclude from the analysis *)
+  ; references_paths : Utils.StringSet.t
+      (** Paths to explore for references only *)
+  ; sections : Sections.t (** Config for the different report sections *)
+  }
+
+val default_config : t
+(** Default configuration for the analysis.
+    By default [verbose], [internal], and [underscore] are [false]
+    By default [paths_to_analyze], [excluded_paths], and [references_paths] are empty.
+    By default [sections] is [Sections.default] *)
+
+val must_report_main : t -> bool
+(** [must_report_main config] indicates if any of the main sections
+    is activated in [config] *)
+
+val must_report_opt_args : t -> bool
+(** [must_report_opt_args config] indicates if any of the optional
+    arguments section is activated in [config] *)
+
+val update_style : string -> t -> t
+(** [update_style arg config] returns a [config] with style section
+    configuration updated according to the [arg] specification. *)
+
+val is_excluded : string -> t -> bool
+(** [is_excluded path config] indicates if [path] is excluded from the analysis
+    in [config].
+    Excluding a path is done with the --exclude command line argument. *)
+
+val parse_cli : unit -> t
+(** [parse_cli ()] returns a fresh configuration filled up according to the
+    command line arguments *)