Enhanced error messages for invalid library/executables names (#3646)

* Gather and update `field-name` tests

Signed-off-by: Ulysse Gérard <thevoodoos@gmail.com>

* Validate modules' name field after parsing

Signed-off-by: Ulysse Gérard <thevoodoos@gmail.com>

* Hint user with valid module names

Signed-off-by: Ulysse Gérard <thevoodoos@gmail.com>

* Code style changes

Signed-off-by: Rudi Grinberg <me@rgrinberg.com>

Co-authored-by: Rudi Grinberg <me@rgrinberg.com>

src/dune/context_name.ml

@@ -25,6 +25,8 @@ include (
 
     let description_of_valid_string = None
 
+    let hint_valid = None
+
     let to_string = T.to_string
 
     let module_ = "Context_name"

src/dune/dune_file.ml

@@ -622,17 +622,17 @@ module Library = struct
          | Some (loc, res), _ -> (loc, res)
          | None, Some { name = loc, name; _ } ->
            if dune_version >= (1, 1) then
-             match Lib_name.to_local name with
-             | Some m -> (loc, m)
-             | None ->
+             match Lib_name.to_local (loc, name) with
+             | Ok m -> (loc, m)
+             | Error user_message ->
                User_error.raise ~loc
                  [ Pp.textf "Invalid library name."
                  ; Pp.text
                      "Public library names don't have this restriction. You \
                       can either change this public name to be a valid library \
                       name or add a \"name\" field with a valid library name."
                  ]
-                 ~hints:[ Lib_name.Local.valid_format_doc ]
+                 ~hints:(Lib_name.Local.valid_format_doc :: user_message.hints)
            else
              User_error.raise ~loc
                [ Pp.text
@@ -971,6 +971,10 @@ module Executables = struct
       let stanza = pluralize stanza ~multi in
       let names =
         let open Dune_lang.Syntax.Version.Infix in
+        Option.iter names
+          ~f:
+            (List.iter ~f:(fun name ->
+                 ignore (Module_name.parse_string_exn name : Module_name.t)));
         match (names, public_names) with
         | Some names, _ -> names
         | None, Some public_names ->
@@ -980,7 +984,20 @@ module Executables = struct
                 | None ->
                   User_error.raise ~loc
                     [ Pp.text "This executable must have a name field" ]
-                | Some s -> (loc, s))
+                | Some s -> (
+                  match Module_name.of_string_user_error (loc, s) with
+                  | Ok _ -> (loc, s)
+                  | Error user_message ->
+                    User_error.raise ~loc
+                      [ Pp.textf "Invalid module name."
+                      ; Pp.text
+                          "Public executable names don't have this \
+                           restriction. You can either change this public name \
+                           to be a valid module name or add a \"name\" field \
+                           with a valid module name."
+                      ]
+                      ~hints:(Module_name.valid_format_doc :: user_message.hints)
+                  ))
           else
             User_error.raise ~loc
               [ Pp.textf "%s field may not be omitted before dune version %s"

src/dune/lib_name.ml

@@ -12,6 +12,14 @@ module Local = struct
     Stringlike.Make (struct
       type t = string
 
+      let valid_char = function
+        | 'A' .. 'Z'
+        | 'a' .. 'z'
+        | '_'
+        | '0' .. '9' ->
+          true
+        | _ -> false
+
       let to_string s = s
 
       let module_ = "Lib_name.Local"
@@ -20,13 +28,18 @@ module Local = struct
 
       let description_of_valid_string = Some valid_format_doc
 
-      let valid_char = function
-        | 'A' .. 'Z'
-        | 'a' .. 'z'
-        | '_'
-        | '0' .. '9' ->
-          true
-        | _ -> false
+      let hint_valid =
+        Some
+          (fun name ->
+            String.filter_map name ~f:(fun c ->
+                if valid_char c then
+                  Some c
+                else
+                  match c with
+                  | '.'
+                  | '-' ->
+                    Some '_'
+                  | _ -> None))
 
       let of_string_opt (name : string) =
         match name with
@@ -61,13 +74,15 @@ let split t =
   | [] -> assert false
   | pkg :: rest -> (Package.Name.of_string pkg, rest)
 
-let to_local = Local.of_string_opt
+let to_local = Local.of_string_user_error
 
 include Stringlike.Make (struct
   type nonrec t = string
 
   let description_of_valid_string = None
 
+  let hint_valid = None
+
   let to_string s = s
 
   let module_ = "Lib_name"

src/dune/lib_name.mli

@@ -19,7 +19,7 @@ val equal : t -> t -> bool
 
 val of_local : Loc.t * Local.t -> t
 
-val to_local : t -> Local.t option
+val to_local : Loc.t * t -> (Local.t, User_message.t) result
 
 val split : t -> Package.Name.t * string list
 

src/dune/module_name.ml

@@ -1,15 +1,42 @@
 open Stdune
 
+let valid_format_doc =
+  Pp.text
+    "Module names must be non-empty and composed only of the following \
+     characters: 'A'..'Z', 'a'..'z', '_', ''' or '0'..'9'."
+
 include Stringlike.Make (struct
   type t = string
 
+  let valid_char = function
+    | 'A' .. 'Z'
+    | 'a' .. 'z'
+    | '0' .. '9'
+    | '\''
+    | '_' ->
+      true
+    | _ -> false
+
   let to_string s = s
 
   let description = "module name"
 
   let module_ = "Module_name"
 
-  let description_of_valid_string = None
+  let description_of_valid_string = Some valid_format_doc
+
+  let hint_valid =
+    Some
+      (fun name ->
+        String.filter_map name ~f:(fun c ->
+            if valid_char c then
+              Some c
+            else
+              match c with
+              | '.'
+              | '-' ->
+                Some '_'
+              | _ -> None))
 
   let is_valid_module_name name =
     match name with
@@ -21,14 +48,8 @@ include Stringlike.Make (struct
         | 'a' .. 'z' ->
           ()
         | _ -> raise_notrace Exit );
-        String.iter s ~f:(function
-          | 'A' .. 'Z'
-          | 'a' .. 'z'
-          | '0' .. '9'
-          | '\''
-          | '_' ->
-            ()
-          | _ -> raise_notrace Exit);
+        String.iter s ~f:(fun c ->
+            if not (valid_char c) then raise_notrace Exit);
         true
       with Exit -> false )
 

src/dune/module_name.mli

@@ -3,6 +3,9 @@ open Stdune
 (** Represents a valid OCaml module name *)
 type t
 
+(** Description of valid module names *)
+val valid_format_doc : User_message.Style.t Pp.t
+
 include Stringlike_intf.S with type t := t
 
 val add_suffix : t -> string -> t

src/dune/package.ml

@@ -30,6 +30,8 @@ module Name = struct
 
       let description_of_valid_string = None
 
+      let hint_valid = None
+
       let of_string_opt s =
         (* DUNE3 verify no dots or spaces *)
         if s = "" then

src/dune/profile.ml

@@ -23,6 +23,8 @@ include (
 
     let description_of_valid_string = None
 
+    let hint_valid = None
+
     let to_string = function
       | Dev -> "dev"
       | Release -> "release"

src/dune/stringlike.ml

@@ -14,12 +14,17 @@ module Make (S : Stringlike_intf.S_base) = struct
   let error_message s = Printf.sprintf "%S is an invalid %s." s S.description
 
   let user_error (loc, s) =
+    let hints =
+      match S.hint_valid with
+      | None -> []
+      | Some f -> [ Pp.textf "%s would be a correct %s" (f s) S.description ]
+    in
     let valid_desc =
       match S.description_of_valid_string with
       | None -> []
       | Some m -> [ m ]
     in
-    User_error.make ~loc (Pp.text (error_message s) :: valid_desc)
+    User_error.make ~loc ~hints (Pp.text (error_message s) :: valid_desc)
 
   let of_string_user_error (loc, s) =
     match of_string_opt s with

src/dune/stringlike_intf.ml

@@ -15,6 +15,10 @@ module type S_base = sig
       present *)
   val description_of_valid_string : 'a Pp.t option
 
+  (** A function suggesting a valid replacement for an erroneous input. Will be
+      added to error messages if present *)
+  val hint_valid : (string -> string) option
+
   val of_string_opt : string -> t option
 
   val to_string : t -> string
@@ -36,6 +40,8 @@ module type S = sig
 
   val of_string_opt : string -> t option
 
+  val of_string_user_error : Loc.t * string -> (t, User_message.t) result
+
   (** From&to string conversions, for use with [Cmdliner.Arg.conv] *)
   val conv :
     (string -> (t, [> `Msg of string ]) result)

src/stdune/string.ml

@@ -305,3 +305,7 @@ let of_list chars =
   let s = Bytes.make (List.length chars) '0' in
   List.iteri chars ~f:(fun i c -> Bytes.set s i c);
   Bytes.to_string s
+
+let filter_map t ~f =
+  (* TODO more efficient implementation *)
+  to_seq t |> Seq.filter_map ~f |> of_seq

src/stdune/string.mli

@@ -128,3 +128,5 @@ val need_quoting : string -> bool
 (** [quote_for_shell s] quotes [s] using [Filename.quote] if [need_quoting s] is
     [true] *)
 val quote_for_shell : string -> string
+
+val filter_map : string -> f:(char -> char option) -> string

test/blackbox-tests/dune.inc

@@ -2116,17 +2116,6 @@
    test-cases/no-installable-mode.t
    (progn (run dune-cram run run.t) (diff? run.t run.t.corrected)))))
 
-(rule
- (alias no-name-field)
- (deps
-  (package dune)
-  (source_tree test-cases/no-name-field.t)
-  (alias test-deps))
- (action
-  (chdir
-   test-cases/no-name-field.t
-   (progn (run dune-cram run run.t) (diff? run.t run.t.corrected)))))
-
 (rule
  (alias null-dep)
  (deps (package dune) (source_tree test-cases/null-dep.t) (alias test-deps))
@@ -3397,7 +3386,6 @@
   (alias name-field-validation)
   (alias no-infer)
   (alias no-installable-mode)
-  (alias no-name-field)
   (alias null-dep)
   (alias ocaml-config-macro)
   (alias ocaml-syntax)
@@ -3684,7 +3672,6 @@
   (alias name-field-validation)
   (alias no-infer)
   (alias no-installable-mode)
-  (alias no-name-field)
   (alias null-dep)
   (alias ocaml-config-macro)
   (alias ocaml-syntax)

test/blackbox-tests/test-cases/name-field-validation.t/name-invalid-exe/dune

@@ -0,0 +1,2 @@
+(executable
+ (name a.b))

test/blackbox-tests/test-cases/name-field-validation.t/name-invalid-exe/dune-project

@@ -0,0 +1 @@
+(lang dune 2.6)

test/blackbox-tests/test-cases/name-field-validation.t/public-name-invalid-exe/dune

@@ -0,0 +1,2 @@
+(executable
+ (public_name a.b))

test/blackbox-tests/test-cases/name-field-validation.t/public-name-invalid-exe/dune-project

@@ -0,0 +1 @@
+(lang dune 2.6)