Allow dash in dune init project name (#11402)

Signed-off-by: ArthurW <[email protected]>

bin/dune_init.ml

@@ -245,20 +245,27 @@ module Component = struct
     module Common = struct
       type t =
         { name : Dune_lang.Atom.t
+        ; public : Public_name.t option
         ; libraries : Dune_lang.Atom.t list
         ; pps : Dune_lang.Atom.t list
         }
+
+      let package_name common =
+        let name =
+          match common.public with
+          | None -> Dune_lang.Atom.to_string common.name
+          | Some public -> Public_name.to_string public
+        in
+        Package.Name.of_string name
+      ;;
     end
 
     module Executable = struct
-      type t = { public : Public_name.t option }
+      type t = unit
     end
 
     module Library = struct
-      type t =
-        { public : Public_name.t option
-        ; inline_tests : bool
-        }
+      type t = { inline_tests : bool }
     end
 
     module Project = struct
@@ -355,11 +362,11 @@ module Component = struct
 
     let public_name_field = Encoder.field_o "public_name" Public_name.encode
 
-    let executable (common : Options.Common.t) (options : Options.Executable.t) =
-      make "executable" common [ public_name_field options.public ]
+    let executable (common : Options.Common.t) (() : Options.Executable.t) =
+      make "executable" common [ public_name_field common.public ]
     ;;
 
-    let library (common : Options.Common.t) { Options.Library.inline_tests; public } =
+    let library (common : Options.Common.t) { Options.Library.inline_tests } =
       check_module_name common.name;
       let common =
         if inline_tests
@@ -370,7 +377,10 @@ module Component = struct
           { common with pps })
         else common
       in
-      make "library" common [ public_name_field public; Field.inline_tests inline_tests ]
+      make
+        "library"
+        common
+        [ public_name_field common.public; Field.inline_tests inline_tests ]
     ;;
 
     let test common (() : Options.Test.t) = make "test" common []
@@ -385,7 +395,7 @@ module Component = struct
       let cst =
         let package =
           Package.create
-            ~name:(Package.Name.of_string (Atom.to_string common.name))
+            ~name:(Options.Common.package_name common)
             ~loc:Loc.none
             ~version:None
             ~conflicts:[]
@@ -499,8 +509,8 @@ module Component = struct
       let lib_target =
         src
           { context = { context with dir = Path.relative dir "lib" }
-          ; options = { public = None; inline_tests = options.inline_tests }
-          ; common
+          ; options = { inline_tests = options.inline_tests }
+          ; common = { common with public = None }
           }
       in
       let test_target =
@@ -516,7 +526,7 @@ module Component = struct
         let libraries = Stanza_cst.add_to_list_set common.name common.libraries in
         bin
           { context = { context with dir = Path.relative dir "bin" }
-          ; options = { public = Some (Public_name.of_name_exn common.name) }
+          ; options = ()
           ; common = { common with libraries; name = Dune_lang.Atom.of_string "main" }
           }
       in
@@ -527,10 +537,7 @@ module Component = struct
       let lib_target =
         src
           { context = { context with dir = Path.relative dir "lib" }
-          ; options =
-              { public = Some (Public_name.of_name_exn common.name)
-              ; inline_tests = options.inline_tests
-              }
+          ; options = { inline_tests = options.inline_tests }
           ; common
           }
       in
@@ -548,13 +555,11 @@ module Component = struct
     let proj ({ common; options; _ } as opts : Options.Project.t Options.t) =
       let ({ template; pkg; _ } : Options.Project.t) = options in
       let dir = Path.Source.root in
-      let name =
-        Package.Name.parse_string_exn (Loc.none, Dune_lang.Atom.to_string common.name)
-      in
       let proj_target =
         let package_files =
           match (pkg : Options.Project.Pkg.t) with
           | Opam ->
+            let name = Options.Common.package_name common in
             let opam_file = Path.source @@ Package_name.file name ~dir in
             [ File.make_text (Path.parent_exn opam_file) (Path.basename opam_file) "" ]
           | Esy -> [ File.make_text (Path.source dir) "package.json" "" ]

bin/dune_init.mli

@@ -32,22 +32,21 @@ module Component : sig
     module Common : sig
       type t =
         { name : Dune_lang.Atom.t
+        ; public : Public_name.t option
         ; libraries : Dune_lang.Atom.t list
         ; pps : Dune_lang.Atom.t list
         }
     end
 
     (** Options for executable components *)
     module Executable : sig
-      type t = { public : Public_name.t option }
+      (** NOTE: no options supported yet *)
+      type t = unit
     end
 
     (** Options for library components *)
     module Library : sig
-      type t =
-        { public : Public_name.t option
-        ; inline_tests : bool
-        }
+      type t = { inline_tests : bool }
     end
 
     (** Options for test components *)

bin/init.ml

@@ -31,8 +31,28 @@ let component_name_parser s =
   Ok atom
 ;;
 
+let project_name_parser s =
+  (* TODO refactor Dune_project_name to be Stringlike *)
+  match Dune_project_name.named Loc.none s with
+  | v -> Ok v
+  | exception User_error.E _ ->
+    User_error.make
+      [ Pp.textf "invalid project name `%s'" s
+      ; Pp.text
+          "Project names must start with a letter and be composed only of letters, \
+           numbers, '-' or '_'"
+      ]
+    |> User_message.to_string
+    |> fun m -> Error (`Msg m)
+;;
+
+let project_name_printer ppf p =
+  Format.pp_print_string ppf (Dune_project_name.to_string_hum p)
+;;
+
 let atom_conv = Arg.conv (atom_parser, atom_printer)
 let component_name_conv = Arg.conv (component_name_parser, atom_printer)
+let project_name_conv = Arg.conv (project_name_parser, project_name_printer)
 
 (** {2 Status reporting} *)
 
@@ -48,22 +68,6 @@ let print_completion kind name =
 
 (** {1 CLI} *)
 
-let common : Component.Options.Common.t Term.t =
-  let+ name =
-    let docv = "NAME" in
-    Arg.(required & pos 0 (some component_name_conv) None & info [] ~docv)
-  and+ libraries =
-    let docv = "LIBRARIES" in
-    let doc = "A comma separated list of libraries on which the component depends" in
-    Arg.(value & opt (list atom_conv) [] & info [ "libs" ] ~docv ~doc)
-  and+ pps =
-    let docv = "PREPROCESSORS" in
-    let doc = "A comma separated list of ppx preprocessors used by the component" in
-    Arg.(value & opt (list atom_conv) [] & info [ "ppx" ] ~docv ~doc)
-  in
-  { Component.Options.Common.name; libraries; pps }
-;;
-
 let path =
   let docv = "PATH" in
   Arg.(value & pos 1 (some string) None & info [] ~docv)
@@ -89,9 +93,9 @@ module Public_name = struct
     | Public_name p -> Public_name.to_string p
   ;;
 
-  let public_name (common : Component.Options.Common.t) = function
+  let public_name default_name = function
     | None -> None
-    | Some Use_name -> Some (Public_name.of_name_exn common.name)
+    | Some Use_name -> Some (Public_name.of_name_exn default_name)
     | Some (Public_name n) -> Some n
   ;;
 
@@ -111,6 +115,18 @@ module Public_name = struct
   ;;
 end
 
+let libraries =
+  let docv = "LIBRARIES" in
+  let doc = "A comma separated list of libraries on which the component depends" in
+  Arg.(value & opt (list atom_conv) [] & info [ "libs" ] ~docv ~doc)
+;;
+
+let pps =
+  let docv = "PREPROCESSORS" in
+  let doc = "A comma separated list of ppx preprocessors used by the component" in
+  Arg.(value & opt (list atom_conv) [] & info [ "ppx" ] ~docv ~doc)
+;;
+
 let public : Public_name.t option Term.t =
   let docv = "PUBLIC_NAME" in
   let doc =
@@ -123,6 +139,38 @@ let public : Public_name.t option Term.t =
     & info [ "public" ] ~docv ~doc)
 ;;
 
+let common : Component.Options.Common.t Term.t =
+  let+ name =
+    let docv = "NAME" in
+    Arg.(required & pos 0 (some component_name_conv) None & info [] ~docv)
+  and+ public = public
+  and+ libraries = libraries
+  and+ pps = pps in
+  let public = Public_name.public_name name public in
+  { Component.Options.Common.name; public; libraries; pps }
+;;
+
+let project_common : Component.Options.Common.t Term.t =
+  let+ project_name =
+    let docv = "NAME" in
+    Arg.(required & pos 0 (some project_name_conv) None & info [] ~docv)
+  and+ libraries = libraries
+  and+ pps = pps in
+  let public = Dune_project_name.to_string_hum project_name in
+  let name =
+    String.map
+      ~f:(function
+        | '-' -> '_'
+        | c -> c)
+      public
+    |> Dune_lang.Atom.of_string
+  in
+  let public =
+    Some (Dune_lang.Atom.of_string public |> Dune_init.Public_name.of_name_exn)
+  in
+  { Component.Options.Common.name; public; libraries; pps }
+;;
+
 let inline_tests : bool Term.t =
   let docv = "USE_INLINE_TESTS" in
   let doc =
@@ -140,10 +188,8 @@ let executable =
   let kind = "executable" in
   Cmd.v (Cmd.info kind ~doc ~man)
   @@ let+ context = context_cwd
-     and+ common = common
-     and+ public = public in
-     let public = Public_name.public_name common public in
-     Component.init (Executable { context; common; options = { public } });
+     and+ common = common in
+     Component.init (Executable { context; common; options = () });
      print_completion kind common.name
 ;;
 
@@ -154,10 +200,8 @@ let library =
   Cmd.v (Cmd.info kind ~doc ~man)
   @@ let+ context = context_cwd
      and+ common = common
-     and+ public = public
      and+ inline_tests = inline_tests in
-     let public = Public_name.public_name common public in
-     Component.init (Library { context; common; options = { public; inline_tests } });
+     Component.init (Library { context; common; options = { inline_tests } });
      print_completion kind common.name
 ;;
 
@@ -187,7 +231,7 @@ let project =
   Cmd.v (Cmd.info "project" ~doc ~man)
   @@ let+ common_builder = Builder.term
      and+ path = path
-     and+ common = common
+     and+ common = project_common
      and+ inline_tests = inline_tests
      and+ template =
        let docv = "PROJECT_KIND" in
@@ -215,9 +259,13 @@ let project =
            & opt (some (enum Component.Options.Project.Pkg.commands)) None
            & info [ "pkg" ] ~docv ~doc)
      in
+     let name =
+       match common.public with
+       | None -> Dune_lang.Atom.to_string common.name
+       | Some public -> Dune_init.Public_name.to_string public
+     in
      let context =
        let init_context = Init_context.make path in
-       let name = Dune_lang.Atom.to_string common.name in
        let root =
          match path with
          (* If a path is given, we use that for the root during project
@@ -235,7 +283,7 @@ let project =
      in
      Component.init
        (Project { context; common; options = { template; inline_tests; pkg } });
-     print_completion "project" common.name
+     print_completion "project" (Dune_lang.Atom.of_string name)
 ;;
 
 let group =

doc/changes/11402.md

@@ -0,0 +1 @@
+- Allow dash in dune init project name (#11402, @art-w, reported by @saroupille)

test/blackbox-tests/test-cases/dune-init/github11210.t

@@ -0,0 +1,26 @@
+Dash are allowed in project names and should be accepted:
+
+  $ dune init project dash-exe
+  Entering directory 'dash-exe'
+  Success: initialized project component named dash-exe
+  Leaving directory 'dash-exe'
+  $ cd dash-exe && dune build
+
+  $ dune init project dash-lib --kind=library
+  Entering directory 'dash-lib'
+  Success: initialized project component named dash-lib
+  Leaving directory 'dash-lib'
+  $ cd dash-lib && dune build
+
+Invalid project names should still be rejected:
+
+  $ dune init project invalid.name
+  dune: NAME argument: invalid project name `invalid.name'
+        Project names must start with a letter and be composed only of
+        letters,
+        numbers, '-' or '_'
+  Usage: dune init project [OPTION]… NAME [PATH]
+  Try 'dune init project --help' or 'dune --help' for more information.
+  [1]
+  $ dune_cmd exists invalid.name
+  false