Merge pull request #112 from mbarbin/fix-dune-version-parsing-error

mbarbin · web-flow · commit a689f2e4327a · 2025-09-26T12:42:47.000+02:00
Fix dune version parsing error
diff --git a/lib/dune_project_linter/src/dune_lang_version.ml b/lib/dune_project_linter/src/dune_lang_version.ml
@@ -28,18 +28,28 @@ let create ~dune_lang_version = { dune_lang_version }
 let dune_lang_version t = t.dune_lang_version
 let set_dune_lang_version t ~dune_lang_version = t.dune_lang_version <- dune_lang_version
 
-let read ~sexps_rewriter:_ ~field =
+let read ~sexps_rewriter ~field =
   match field with
-  | Sexp.List [ Sexp.Atom "lang"; Sexp.Atom "dune"; Sexp.Atom version_string ] ->
+  | Sexp.List [ Sexp.Atom "lang"; Sexp.Atom "dune"; (Sexp.Atom version_string as atom) ]
+    ->
     (* Parse version string like "3.17" into tuple (3, 17) *)
     (match String.split version_string ~on:'.' with
      | [ major_str; minor_str ] ->
        (match Int.of_string major_str, Int.of_string minor_str with
         | major, minor ->
           { dune_lang_version = Dune_project.Dune_lang_version.create (major, minor) }
-        | exception _ -> failwith ("Invalid version format: " ^ version_string))
-     | _ -> failwith ("Expected VERSION.MINOR format, got: " ^ version_string))
-  | _ -> failwith "Expected (lang dune VERSION) format"
+        | exception _ ->
+          Err.raise
+            ~loc:(Sexps_rewriter.loc sexps_rewriter atom)
+            [ Pp.textf "Invalid version format: %S." version_string ])
+     | _ ->
+       Err.raise
+         ~loc:(Sexps_rewriter.loc sexps_rewriter atom)
+         [ Pp.textf "Expected VERSION.MINOR format, got: %S." version_string ])
+  | _ ->
+    Err.raise
+      ~loc:(Sexps_rewriter.loc sexps_rewriter field)
+      [ Pp.text "Expected (lang dune VERSION) format." ]
 ;;
 
 let write t =
diff --git a/lib/dune_project_linter/test/test__dune_lang_version.ml b/lib/dune_project_linter/test/test__dune_lang_version.ml
@@ -39,23 +39,23 @@ let%expect_test "read/write" =
   test {| (lang dune 3.INVALID) |};
   [%expect
     {|
-    Internal Error: Failure("Invalid version format: 3.INVALID")
-    <backtrace disabled in tests>
-    [125]
+    File "dune-project", line 1, characters 12-21:
+    Error: Invalid version format: "3.INVALID".
+    [123]
     |}];
   test {| (lang dune invalid) |};
   [%expect
     {|
-    Internal Error: Failure("Expected VERSION.MINOR format, got: invalid")
-    <backtrace disabled in tests>
-    [125]
+    File "dune-project", line 1, characters 12-19:
+    Error: Expected VERSION.MINOR format, got: "invalid".
+    [123]
     |}];
   test {| (lang invalid 3.20) |};
   [%expect
     {|
-    Internal Error: Failure("Expected (lang dune VERSION) format")
-    <backtrace disabled in tests>
-    [125]
+    File "dune-project", line 1, characters 1-20:
+    Error: Expected (lang dune VERSION) format.
+    [123]
     |}];
   ()
 ;;
diff --git a/lib/dunolint_cli/src/cmd__lint.ml b/lib/dunolint_cli/src/cmd__lint.ml
@@ -23,7 +23,7 @@ let main =
   Command.make
     ~summary:"Lint project."
     (let open Command.Std in
-     let+ dunolint_engine_config = Dunolint_engine.Config.arg
+     let+ running_mode = Dunolint_engine.Running_mode.arg
      and+ () = Log_cli.set_config ()
      and+ config =
        Arg.named_opt [ "config" ] Param.file ~doc:"Path to dunolint config file."
@@ -39,7 +39,7 @@ let main =
      let config =
        Common_helpers.load_config_opt_exn ~config ~append_extra_rules:enforce
      in
-     Dunolint_engine.run ~config:dunolint_engine_config
+     Dunolint_engine.run ~running_mode
      @@ fun dunolint_engine ->
      Dunolint_engine.visit
        dunolint_engine
diff --git a/lib/dunolint_cli/src/linter.mli b/lib/dunolint_cli/src/linter.mli
@@ -27,12 +27,6 @@ val lint_stanza
   -> return:[> `skip_subtree ] With_return.return
   -> unit
 
-module Visitor_decision : sig
-  type t =
-    | Continue
-    | Skip_subtree
-end
-
 val visit_directory
   :  dunolint_engine:Dunolint_engine.t
   -> config:Dunolint.Config.t
diff --git a/lib/dunolint_engine/src/dunolint_engine.ml b/lib/dunolint_engine/src/dunolint_engine.ml
@@ -24,8 +24,8 @@ module Unix = UnixLabels
 
 let src = Logs.Src.create "dunolint" ~doc:"dunolint"
 
-module Config = Config
 module File_kind = File_kind
+module Running_mode = Running_mode
 
 module Edited_file = struct
   (* Edited files are indexed by their path relative to the root_path provided
@@ -38,11 +38,13 @@ module Edited_file = struct
 end
 
 type t =
-  { config : Config.t
+  { running_mode : Running_mode.t
   ; edited_files : Edited_file.t Hashtbl.M(Relative_path).t
   }
 
-let create ~config = { config; edited_files = Hashtbl.create (module Relative_path) }
+let create ~running_mode () =
+  { running_mode; edited_files = Hashtbl.create (module Relative_path) }
+;;
 
 let file_exists ~path =
   match (Unix.stat (Relative_path.to_string path)).st_kind with
@@ -246,7 +248,7 @@ let rec mkdirs path =
 ;;
 
 let materialize t =
-  let running_mode = Config.running_mode t.config in
+  let running_mode = t.running_mode in
   let edited_files =
     Hashtbl.to_alist t.edited_files
     |> List.sort ~compare:(fun (p1, _) (p2, _) -> Relative_path.compare p1 p2)
@@ -425,12 +427,12 @@ let visit ?below (_ : t) ~f =
   visit [ [ root_path ] ]
 ;;
 
-let run ~config f =
-  let t = create ~config in
+let run ~running_mode f =
+  let t = create ~running_mode () in
   let result = f t in
   materialize t;
   let () =
-    match Config.running_mode config with
+    match running_mode with
     | Dry_run | Force_yes | Interactive -> ()
     | Check ->
       if not (Hashtbl.is_empty t.edited_files)
diff --git a/lib/dunolint_engine/src/dunolint_engine.mli b/lib/dunolint_engine/src/dunolint_engine.mli
@@ -19,8 +19,8 @@
 (*_  <http://www.gnu.org/licenses/> and <https://spdx.org>, respectively.         *)
 (*_********************************************************************************)
 
-module Config = Config
 module File_kind = File_kind
+module Running_mode = Running_mode
 
 type t
 
@@ -91,8 +91,8 @@ val lint_file
 val format_dune_file : new_contents:string -> string
 
 (** This calls [f] once, registers all requests enqueued during the execution of
-    [f], and then depending on the config, either do a dry-run, or actually
-    perform the desired transformations.
+    [f], and then depending on the running mode, either do a dry-run, or
+    actually perform the desired transformations.
 
     The intended use is for [f] to contain one or several calls to a function
     that uses [t] to perform some dunolint linting, such as [visit],
@@ -104,11 +104,11 @@ val format_dune_file : new_contents:string -> string
     In addition to enqueuing debug messages and errors, this function outputs
     messages regarding I/O actions executed during linting. These messages are
     produced onto [stdout]. *)
-val run : config:Config.t -> (t -> 'a) -> 'a
+val run : running_mode:Running_mode.t -> (t -> 'a) -> 'a
 
 (** {1 Step by step API} *)
 
-val create : config:Config.t -> t
+val create : running_mode:Running_mode.t -> unit -> t
 
 (** Apply all the changes that have been saved into [t] to the file system, or
     merely print them if we're in dry-run mode. *)
diff --git a/lib/dunolint_engine/src/running_mode.ml b/lib/dunolint_engine/src/running_mode.ml
@@ -19,26 +19,20 @@
 (*  <http://www.gnu.org/licenses/> and <https://spdx.org>, respectively.         *)
 (*********************************************************************************)
 
-module Running_mode = struct
-  type t =
-    | Dry_run
-    | Check
-    | Force_yes
-    | Interactive
-  [@@deriving compare, equal, sexp_of]
-end
+type t =
+  | Dry_run
+  | Check
+  | Force_yes
+  | Interactive
+[@@deriving compare, equal, sexp_of]
 
-type t = { running_mode : Running_mode.t } [@@deriving sexp_of]
-
-let default = { running_mode = Interactive }
-let running_mode t = t.running_mode
-let create ~running_mode = { running_mode }
+let default = Interactive
 
 let arg =
   let open Command.Std in
   let running_mode
         ((switch :: _ : _ Command.Nonempty_list.t) as switches)
-        ~(running_mode : Running_mode.t)
+        ~(running_mode : t)
         ~doc
     =
     Arg.flag switches ~doc
@@ -74,7 +68,7 @@ let arg =
          Exit with a non-zero exit code in case some linting changes are required. This \
          execution mode is meant for scripts and CI pipelines."
   in
-  let running_mode : Running_mode.t =
+  let running_mode : t =
     match List.filter_opt [ dry_run; interactive; yes; check ] with
     | [] -> if Unix.isatty Unix.stdout then Interactive [@coverage off] else Force_yes
     | [ (_, mode) ] -> mode
@@ -90,5 +84,5 @@ let arg =
     (* [@coverage off] is due to out edge instrumentation, but this
        case is exercised during the tests. *)
   in
-  { running_mode }
+  running_mode
 ;;
diff --git a/lib/dunolint_engine/src/running_mode.mli b/lib/dunolint_engine/src/running_mode.mli
@@ -19,24 +19,12 @@
 (*_  <http://www.gnu.org/licenses/> and <https://spdx.org>, respectively.         *)
 (*_********************************************************************************)
 
-type t [@@deriving sexp_of]
+type t =
+  | Dry_run
+  | Check
+  | Force_yes
+  | Interactive
+[@@deriving compare, equal, sexp_of]
 
 val default : t
 val arg : t Cmdlang.Command.Arg.t
-
-(** {1 Getters} *)
-
-module Running_mode : sig
-  type t =
-    | Dry_run
-    | Check
-    | Force_yes
-    | Interactive
-  [@@deriving compare, equal, sexp_of]
-end
-
-val running_mode : t -> Running_mode.t
-
-(** {1 Create} *)
-
-val create : running_mode:Running_mode.t -> t
diff --git a/lib/dunolint_engine/test/test__dunolint_engine.ml b/lib/dunolint_engine/test/test__dunolint_engine.ml
@@ -23,9 +23,7 @@ open Dunolint.Config.Std
 module Unix = UnixLabels
 
 let%expect_test "lint" =
-  let t =
-    Dunolint_engine.create ~config:(Dunolint_engine.Config.create ~running_mode:Dry_run)
-  in
+  let t = Dunolint_engine.create ~running_mode:Dry_run () in
   Out_channel.write_all
     "dune-project"
     ~data:
@@ -149,9 +147,7 @@ let%expect_test "format_dune_file" =
 
 let%expect_test "create-files" =
   (* The engine may be used to create files where they are not initially present. *)
-  let t =
-    Dunolint_engine.create ~config:(Dunolint_engine.Config.create ~running_mode:Force_yes)
-  in
+  let t = Dunolint_engine.create ~running_mode:Force_yes () in
   Dunolint_engine.lint_file t ~path:(Relative_path.v "lib/a/dune") ~create_file:(fun () ->
     let library = Dune_linter.Library.create ~name:(Dune.Library.Name.v "my-lib") () in
     Sexp.to_string_mach (Dune_linter.Library.write library));
@@ -208,9 +204,7 @@ let%expect_test "create-files" =
 
 let%expect_test "lint-absent-files" =
   (* By default, [lint-file] will not create a file if no initializer is supplied. *)
-  let t =
-    Dunolint_engine.create ~config:(Dunolint_engine.Config.create ~running_mode:Force_yes)
-  in
+  let t = Dunolint_engine.create ~running_mode:Force_yes () in
   Dunolint_engine.lint_file t ~path:(Relative_path.v "absent/file/dune");
   [%expect {||}];
   Err.For_test.protect (fun () -> Dunolint_engine.materialize t);
@@ -237,9 +231,7 @@ let%expect_test "invalid files" =
   (* When encountering invalid files during linting, errors are reported, but
      the execution continues so other valid files are still linted. *)
   Err.For_test.protect (fun () ->
-    let t =
-      Dunolint_engine.create ~config:(Dunolint_engine.Config.create ~running_mode:Dry_run)
-    in
+    let t = Dunolint_engine.create ~running_mode:Dry_run () in
     Unix.mkdir "invalid" ~perm:0o755;
     Out_channel.write_all
       "dune-project"
@@ -295,9 +287,7 @@ let%expect_test "invalid files" =
 
 let%expect_test "file errors" =
   Unix.mkdir "tempdir" ~perm:0o755;
-  let t =
-    Dunolint_engine.create ~config:(Dunolint_engine.Config.create ~running_mode:Force_yes)
-  in
+  let t = Dunolint_engine.create ~running_mode:Force_yes () in
   (* If you are trying to lint a path that is not a regular file, you get an
      error right away rather than during [materialize]. *)
   Err.For_test.protect (fun () ->
@@ -314,9 +304,7 @@ let%expect_test "file errors" =
 ;;
 
 let%expect_test "file-system errors" =
-  let t =
-    Dunolint_engine.create ~config:(Dunolint_engine.Config.create ~running_mode:Force_yes)
-  in
+  let t = Dunolint_engine.create ~running_mode:Force_yes () in
   Dunolint_engine.lint_file t ~path:(Relative_path.v "foo/file") ~create_file:(fun () ->
     "Hello File");
   (* Let's say [foo] gets created as a regular file in the interval. *)
diff --git a/lib/dunolint_engine/test/test__running_mode.ml b/lib/dunolint_engine/test/test__running_mode.ml
@@ -21,10 +21,12 @@
 
 let eval_args args =
   let command =
-    Cmdlang.Command.make Dunolint_engine.Config.arg ~summary:"Test eval-stdlib-runner."
+    Cmdlang.Command.make
+      Dunolint_engine.Running_mode.arg
+      ~summary:"Test eval-stdlib-runner."
   in
   match Cmdlang_stdlib_runner.eval command ~argv:(Array.of_list ("dunolint" :: args)) with
-  | Ok t -> print_s [%sexp (t : Dunolint_engine.Config.t)]
+  | Ok t -> print_s [%sexp (t : Dunolint_engine.Running_mode.t)]
   | Error (`Help msg) -> print_endline msg [@coverage off]
   | Error (`Bad msg) ->
     (Stdlib.print_string msg;
@@ -40,15 +42,15 @@ let%expect_test "running modes" =
      This is indeed what happens during the expect-test, because it is run in a
      context where stdout is not a tty. *)
   eval_args [];
-  [%expect {| ((running_mode Force_yes)) |}];
+  [%expect {| Force_yes |}];
   (* The interactive mode can be forced. *)
   eval_args [ "--interactive" ];
-  [%expect {| ((running_mode Interactive)) |}];
+  [%expect {| Interactive |}];
   (* There are other running modes available. *)
   eval_args [ "--check" ];
-  [%expect {| ((running_mode Check)) |}];
+  [%expect {| Check |}];
   eval_args [ "--dry-run" ];
-  [%expect {| ((running_mode Dry_run)) |}];
+  [%expect {| Dry_run |}];
   (* But they are mutually exclusive. *)
   eval_args [ "--check"; "--dry-run" ];
   [%expect
@@ -61,8 +63,8 @@ let%expect_test "running modes" =
 
 let%expect_test "create" =
   (* The API lets you create config programmatically. *)
-  let t = Dunolint_engine.Config.create ~running_mode:Dry_run in
-  print_s [%sexp (t : Dunolint_engine.Config.t)];
-  [%expect {| ((running_mode Dry_run)) |}];
+  let t = Dunolint_engine.Running_mode.Dry_run in
+  print_s [%sexp (t : Dunolint_engine.Running_mode.t)];
+  [%expect {| Dry_run |}];
   ()
 ;;
diff --git a/lib/dunolint_engine/test/test__running_mode.mli b/lib/dunolint_engine/test/test__running_mode.mli
diff --git a/lib/test_helpers/src/test_helpers.ml b/lib/test_helpers/src/test_helpers.ml
@@ -53,9 +53,7 @@ let is_false b = require_equal [%here] (module Dunolint.Trilang) b False
 let is_undefined b = require_equal [%here] (module Dunolint.Trilang) b Undefined
 
 let run_linter ~config =
-  let dunolint_engine =
-    Dunolint_engine.create ~config:(Dunolint_engine.Config.create ~running_mode:Dry_run)
-  in
+  let dunolint_engine = Dunolint_engine.create ~running_mode:Dry_run () in
   let () =
     Dunolint_engine.visit dunolint_engine ~f:(fun ~parent_dir ~subdirectories:_ ~files ->
       Dunolint_cli.Private.Linter.visit_directory
diff --git a/test/cram/located-errors.t b/test/cram/located-errors.t
