From cc2c3e1ad86db5e1f1975f9d91468254acfc3a17 Mon Sep 17 00:00:00 2001 From: ArthurW Date: Mon, 27 Jan 2025 13:14:33 +0100 Subject: [PATCH] Allow dash in dune init project name Signed-off-by: ArthurW --- bin/dune_init.ml | 45 ++++---- bin/dune_init.mli | 9 +- bin/init.ml | 104 +++++++++++++----- doc/changes/11402.md | 1 + .../test-cases/dune-init/github11210.t | 26 +++++ 5 files changed, 132 insertions(+), 53 deletions(-) create mode 100644 doc/changes/11402.md create mode 100644 test/blackbox-tests/test-cases/dune-init/github11210.t diff --git a/bin/dune_init.ml b/bin/dune_init.ml index db72fdf9b52..334b0d11987 100644 --- a/bin/dune_init.ml +++ b/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" "" ] diff --git a/bin/dune_init.mli b/bin/dune_init.mli index 4e9a4127773..d5076048c49 100644 --- a/bin/dune_init.mli +++ b/bin/dune_init.mli @@ -32,6 +32,7 @@ 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 } @@ -39,15 +40,13 @@ module Component : sig (** 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 *) diff --git a/bin/init.ml b/bin/init.ml index 1763f03ce49..52002fc211f 100644 --- a/bin/init.ml +++ b/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 = diff --git a/doc/changes/11402.md b/doc/changes/11402.md new file mode 100644 index 00000000000..2b533fa457e --- /dev/null +++ b/doc/changes/11402.md @@ -0,0 +1 @@ +- Allow dash in dune init project name (#11402, @art-w, reported by @saroupille) diff --git a/test/blackbox-tests/test-cases/dune-init/github11210.t b/test/blackbox-tests/test-cases/dune-init/github11210.t new file mode 100644 index 00000000000..e469c06b542 --- /dev/null +++ b/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