Tools: use cmdliner library to parse arguments

.github/workflows/ci.yml

@@ -53,19 +53,29 @@ jobs:
         path: ~/.opam
         key: ${{matrix.os}}-rescript-vscode-v4
 
-    - name: Use OCaml
+    - name: Use OCaml ${{matrix.ocaml_compiler}}
       uses: ocaml/setup-ocaml@v2
+      if: matrix.os != 'windows-latest'
       with:
         ocaml-compiler: 4.14.x
 
+    - name: Use OCaml ${{matrix.ocaml_compiler}} (Win)
+      uses: ocaml/setup-ocaml@v2
+      if: matrix.os == 'windows-latest'
+      with:
+        ocaml-compiler: 4.14.x
+        opam-repositories: |
+          sunset: https://github.com/ocaml-opam/opam-repository-mingw.git#sunset
+          default: https://github.com/ocaml/opam-repository.git
+
     - name: Use Node.js
       uses: actions/setup-node@v3
       with:
         node-version: 16
         registry-url: 'https://registry.npmjs.org'
 
     - run: npm ci
-    - run: opam install dune cppo
+    - run: opam install . --deps-only --with-doc --with-test
     - run: npm run compile
 
     # These 2 runs (or just the second?) are for when you have opam dependencies. We don't.

analysis/reanalyze/examples/deadcode/expected/deadcode.txt

@@ -1,4 +1,3 @@
-
   Scanning AutoAnnotate.cmt Source:AutoAnnotate.res
   addVariantCaseDeclaration R AutoAnnotate.res:1:15 path:+AutoAnnotate.variant
   addRecordLabelDeclaration variant AutoAnnotate.res:4:15 path:+AutoAnnotate.record

analysis/reanalyze/examples/deadcode/expected/exception.txt

@@ -1,5 +1,4 @@
 
-
   Exception Analysis
   Exn.res:1:5-10
   raises might raise Not_found (Exn.res:1:19) and is not annotated with @raises(Not_found)

analysis/reanalyze/examples/deadcode/test.sh

@@ -6,7 +6,7 @@ else
   exclude_dirs="src/exception"
   suppress="src/ToSuppress.res"
 fi
-dune exec rescript-editor-analysis -- reanalyze -config -debug -ci -exclude-paths $exclude_dirs -live-names globallyLive1 -live-names globallyLive2,globallyLive3 -suppress $suppress > $output
+dune exec -- rescript-tools reanalyze --dce --config --debug --ci --exclude-paths $exclude_dirs --live-names globallyLive1,globallyLive2,globallyLive3 --suppress $suppress > $output
 # CI. We use LF, and the CI OCaml fork prints CRLF. Convert.
 if [ "$RUNNER_OS" == "Windows" ]; then
   perl -pi -e 's/\r\n/\n/g' -- $output
@@ -18,7 +18,7 @@ if [ "$RUNNER_OS" == "Windows" ]; then
 else
   unsuppress_dirs="src/exception"
 fi
-dune exec rescript-editor-analysis -- reanalyze -exception -ci -suppress src -unsuppress $unsuppress_dirs > $output
+dune exec -- rescript-tools reanalyze --exception --ci --suppress src --unsuppress $unsuppress_dirs > $output
 # CI. We use LF, and the CI OCaml fork prints CRLF. Convert.
 if [ "$RUNNER_OS" == "Windows" ]; then
   perl -pi -e 's/\r\n/\n/g' -- $output

analysis/reanalyze/examples/termination/expected/termination.txt

@@ -1,4 +1,3 @@
-
   Scanning TestCyberTruck.cmt Source:TestCyberTruck.res
 
   Function Table

analysis/reanalyze/examples/termination/test.sh

@@ -1,5 +1,5 @@
 output="expected/termination.txt"
-dune exec rescript-editor-analysis -- reanalyze -config -ci -debug > $output
+dune exec -- rescript-tools reanalyze --termination --config --ci --debug > $output
 # CI. We use LF, and the CI OCaml fork prints CRLF. Convert.
 if [ "$RUNNER_OS" == "Windows" ]; then
   perl -pi -e 's/\r\n/\n/g' -- $output

analysis/reanalyze/src/Reanalyze.ml

@@ -220,3 +220,6 @@ let cli () =
 
 module RunConfig = RunConfig
 module Log_ = Log_
+module Common = Common
+module Paths = Paths
+module DeadCommon = DeadCommon

dune-project

@@ -28,5 +28,7 @@
    (>= 4.10))
   (cppo
    (= 1.6.9))
+  (cmdliner
+    (>= 1.2))
   analysis
   dune))

tools.opam

@@ -8,6 +8,7 @@ bug-reports: "https://github.com/rescript-lang/rescript-vscode/issues"
 depends: [
   "ocaml" {>= "4.10"}
   "cppo" {= "1.6.9"}
+  "cmdliner" {>= "1.2"}
   "analysis"
   "dune"
 ]

tools/CHANGELOG.md

@@ -12,6 +12,13 @@
 
 ## master
 
+## 0.6.0
+
+#### :boom: Breaking Change
+
+- Reanalyze subcommand arguments now starts with two dash `--`. Some commands removed. https://github.com/rescript-lang/rescript-vscode/pull/910
+- ReScript Tools command now generate man pages following GNU conventions. https://github.com/rescript-lang/rescript-vscode/pull/910
+
 ## 0.5.0
 
 #### :rocket: New Feature

tools/bin/dune

@@ -4,6 +4,6 @@
  (modes byte exe)
  ; The main module that will become the binary.
  (name main)
- (libraries tools)
+ (libraries tools analysis cmdliner)
  (flags
   (-w "+6+26+27+32+33+39")))

tools/bin/main.ml

@@ -1,57 +1,277 @@
-let docHelp =
-  {|ReScript Tools
+open Cmdliner
 
-Output documentation to standard output
+let version = Version.version
 
-Usage: rescript-tools doc <FILE>
+module Docgen = struct
+  let run file =
+    let () =
+      match Sys.getenv_opt "FROM_COMPILER" with
+      | Some "true" -> Analysis.Cfg.isDocGenFromCompiler := true
+      | _ -> ()
+    in
+    match Tools.extractDocs ~entryPointFile:file ~debug:false with
+    | Ok s -> `Ok (Printf.printf "%s\n" s)
+    | Error e -> `Error (true, e)
 
-Example: rescript-tools doc ./path/to/EntryPointLib.res|}
+  let docgen_file =
+    let env =
+      let doc =
+        "Internal usage: `true` to generate documentation from \
+         rescript-compiler repo: \
+         https://github.com/rescript-lang/rescript-compiler"
+      in
+      Cmd.Env.info "FROM_COMPILER" ~doc
+    in
+    let doc = "Path to ReScript file" in
+    Arg.(required & (pos 0) (some string) None & info [] ~doc ~env ~docv:"PATH")
 
-let help =
-  {|ReScript Tools
+  let cmd =
+    let doc = "Generate JSON Documentation. Output to standard output" in
+    let info = Cmd.info "doc" ~version ~doc in
+    Cmd.v info Term.(ret (const run $ docgen_file))
+end
 
-Usage: rescript-tools [command]
+module Reanalyze = struct
+  type args = {
+    dce: bool;
+    termination: bool;
+    exception_: bool;
+    ci: bool;
+    config: bool;
+    debug: bool;
+    exclude_paths: string list option;
+    experimental: bool;
+    externals: bool;
+    json: bool;
+    live_names: string list option;
+    live_paths: string list option;
+    cmt_path: string option;
+    write: bool;
+    suppress: string list option;
+    unsuppress: string list option;
+  }
 
-Commands:
+  let run
+      {
+        dce;
+        termination;
+        exception_;
+        ci;
+        config;
+        debug;
+        exclude_paths;
+        experimental;
+        externals;
+        json;
+        live_names;
+        live_paths;
+        cmt_path;
+        write;
+        suppress;
+        unsuppress;
+      } =
+    let open Reanalyze in
+    if dce then RunConfig.dce ();
+    if termination then RunConfig.termination ();
+    if exception_ then RunConfig.exception_ ();
 
-doc                   Generate documentation
-reanalyze             Reanalyze
--v, --version         Print version
--h, --help            Print help|}
+    (* Enable all analysis if dce, termination and exception_ is false *)
+    if (not dce) && (not termination) && not exception_ then RunConfig.all ();
 
-let logAndExit = function
-  | Ok log ->
-    Printf.printf "%s\n" log;
-    exit 0
-  | Error log ->
-    Printf.eprintf "%s\n" log;
-    exit 1
+    let open Common in
+    Cli.debug := debug;
+    Cli.ci := ci;
+    Cli.experimental := experimental;
+    Cli.json := json;
+    Cli.write := write;
+    Cli.liveNames := live_names |> Option.value ~default:[];
+    Cli.livePaths := live_paths |> Option.value ~default:[];
+    Cli.excludePaths := exclude_paths |> Option.value ~default:[];
+    runConfig.unsuppress <- unsuppress |> Option.value ~default:[];
+    runConfig.suppress <- suppress |> Option.value ~default:[];
 
-let version = Version.version
+    DeadCommon.Config.analyzeExternals := externals;
+
+    if config then Paths.Config.processBsconfig ();
+
+    runAnalysisAndReport ~cmtRoot:cmt_path
+
+  let cmd =
+    let doc =
+      "Experimental analyses for ReScript and OCaml: globally dead \
+       values/types, exception analysis, and termination analysis."
+    in
+    let man =
+      [
+        `S Manpage.s_description;
+        `P
+          "Reanalyze command will report all kinds of analysis, dead code \
+           (dce), exception and termination";
+        `S Manpage.s_examples;
+        `I
+          ( "rescript-tools reanalyze",
+            "Report all analysis (dead code, exception and termination)" );
+        `I ("rescript-tools reanalyze --dce", "Report only dead code");
+      ]
+    in
+    let info = Cmd.info "reanalyze" ~doc ~man in
+
+    let exception_ =
+      let doc =
+        "Experimental exception analysis. The exception analysis is designed \
+         to keep track statically of the exceptions that might be raised at \
+         runtime. It works by issuing warnings and recognizing annotations"
+      in
+      Arg.(value & flag & info ["exception"] ~doc)
+    in
+
+    let termination =
+      let doc = "Experimental termination analysis" in
+      Arg.(value & flag & info ["termination"] ~doc)
+    in
+
+    let dce =
+      let doc =
+        "Enable experimental DCE. The dead code analysis reports on globally \
+         dead values, redundant optional arguments, dead modules, dead types \
+         (records and variants)."
+      in
+      Arg.(value & flag & info ["dce"] ~doc)
+    in
+
+    let ci =
+      let doc = "Internal flag for use in CI" in
+      Arg.(value & flag & info ["ci"] ~doc)
+    in
+
+    let config =
+      let doc = "Read the analysis mode from rescript.json or bsconfig.json" in
+      Arg.(value & flag & info ["config"] ~doc)
+    in
+
+    let debug =
+      let doc = "Print debug information" in
+      Arg.(value & flag & info ["debug"] ~doc)
+    in
+
+    let exclude_paths =
+      let doc =
+        "Exclude from analysis files whose path has a prefix in the list"
+      in
+      Arg.(
+        value
+        & opt (some (list ~sep:',' string)) None
+        & info ["exclude-paths"] ~doc ~docv:"PATHS")
+    in
+
+    let experimental =
+      let doc =
+        "Turn on experimental analyses. This option is currently unused"
+      in
+      Arg.(value & flag & info ["experimental"] ~doc)
+    in
+
+    let externals =
+      let doc = "Report on externals in dead code analysis" in
+      Arg.(value & flag & info ["externals"] ~doc)
+    in
+
+    let json =
+      let doc = "Print reports in JSON Format" in
+      Arg.(value & flag & info ["json"] ~doc)
+    in
+
+    let live_names =
+      let doc =
+        "Consider all values with the given name as live. This automatically \
+         annotates @live all the items in list"
+      in
+      Arg.(
+        value
+        & opt (some (list ~sep:',' string)) None
+        & info ["live-names"] ~doc ~docv:"NAMES")
+    in
+
+    let live_paths =
+      let doc =
+        "Consider all values whose path has a prefix in the list as live. This \
+         automatically annotates @live all the items on list"
+      in
+      Arg.(
+        value
+        & opt (some (list ~sep:',' string)) None
+        & info ["live-paths"] ~doc ~docv:"NAMES")
+    in
+
+    let unsuppress =
+      let doc =
+        "Report on files whose path has a prefix in the list. overriding \
+         --suppress (no-op if --suppress is not specified)\n\
+        \         comma-separated-path-prefixes"
+      in
+      Arg.(
+        value
+        & opt (some (list ~sep:',' string)) None
+        & info ["unsuppress"] ~doc ~docv:"PATHS")
+    in
+
+    let suppress =
+      let doc =
+        "Don't report on files whose path has a prefix in the list. \
+         Comma-separated-path-prefixes"
+      in
+      Arg.(
+        value
+        & opt (some (list ~sep:',' string)) None
+        & info ["suppress"] ~doc ~docv:"PATHS")
+    in
+
+    let cmt_path =
+      let doc = "Path to .cmt files" in
+      Arg.(value & opt (some string) None & info ["cmt-path"] ~doc ~docv:"PATH")
+    in
+
+    let write =
+      let doc = "Write @dead annotations directly in the source files" in
+      Arg.(value & flag & info ["write"] ~doc)
+    in
+
+    let parse dce termination exception_ externals live_names live_paths
+        cmt_path exclude_paths suppress unsuppress experimental config ci write
+        json debug =
+      {
+        dce;
+        termination;
+        exception_;
+        ci;
+        config;
+        debug;
+        exclude_paths;
+        experimental;
+        externals;
+        json;
+        live_names;
+        live_paths;
+        write;
+        cmt_path;
+        suppress;
+        unsuppress;
+      }
+    in
+
+    let cmd =
+      Term.(
+        const parse $ dce $ termination $ exception_ $ externals $ live_names
+        $ live_paths $ cmt_path $ exclude_paths $ suppress $ unsuppress
+        $ experimental $ config $ ci $ write $ json $ debug)
+    in
+
+    Cmd.v info Term.(const run $ cmd)
+end
+
+let cmd =
+  let doc = "ReScript Tools" in
+  let info = Cmd.info "rescript-tools" ~version ~doc in
+  Cmd.group info [Docgen.cmd; Reanalyze.cmd]
 
-let main () =
-  match Sys.argv |> Array.to_list |> List.tl with
-  | "doc" :: rest -> (
-    match rest with
-    | ["-h"] | ["--help"] -> logAndExit (Ok docHelp)
-    | [path] ->
-      (* NOTE: Internal use to generate docs from compiler *)
-      let () =
-        match Sys.getenv_opt "FROM_COMPILER" with
-        | Some "true" -> Analysis.Cfg.isDocGenFromCompiler := true
-        | _ -> ()
-      in
-      logAndExit (Tools.extractDocs ~entryPointFile:path ~debug:false)
-    | _ -> logAndExit (Error docHelp))
-  | "reanalyze" :: _ ->
-    let len = Array.length Sys.argv in
-    for i = 1 to len - 2 do
-      Sys.argv.(i) <- Sys.argv.(i + 1)
-    done;
-    Sys.argv.(len - 1) <- "";
-    Reanalyze.cli ()
-  | ["-h"] | ["--help"] -> logAndExit (Ok help)
-  | ["-v"] | ["--version"] -> logAndExit (Ok version)
-  | _ -> logAndExit (Error help)
-
-let () = main ()
+let () = exit (Cmd.eval cmd)