Improve validation of arguments to dune init (#3046, #3088)

CHANGES.md

@@ -1,6 +1,12 @@
 2.3.0 (unreleased)
 ------------------
 
+- Improve validation and error handling of arguments to `dune init` (#3103, fixes
+  #3046, @shonfeder)
+
+- `dune init exec NAME` now uses the `NAME` argument for private modules (#3103,
+  fixes #3088, @shonfeder)
+
 - Avoid linear walk to detect children, this should greatly improve
   performance when a target has a large number of dependencies (#2959,
   @ejgallego, @aalekseyev, @Armael)

bin/init.ml

@@ -2,18 +2,74 @@ open Stdune
 open Import
 open Dune.Dune_init
 
+(** {1 Helper functions} *)
+
+(** {2 Validation} *)
+
 (* TODO(shonfeder): Remove when nested subcommands are available *)
 let validate_component_options kind unsupported_options =
   let report_invalid_option = function
     | _, false -> () (* The option wasn't supplied *)
     | option_name, true ->
       User_error.raise
-        [ Pp.textf "The %s component does not support the %s option"
+        [ Pp.textf "The `%s' component does not support the `--%s' option"
             (Kind.to_string kind) option_name
         ]
   in
   List.iter ~f:report_invalid_option unsupported_options
 
+(** {2 Cmdliner Argument Converters }*)
+
+let atom_parser s =
+  match Dune_lang.Atom.parse s with
+  | Some s -> Ok s
+  | None -> Error (`Msg "expected a valid dune atom")
+
+let atom_printer ppf a = Format.pp_print_string ppf (Dune_lang.Atom.to_string a)
+
+let component_name_parser s =
+  let err_msg () =
+    User_error.make
+      [ Pp.textf "invalid component name `%s'" s ]
+      ~hints:[ Lib_name.Local.valid_format_doc ]
+    |> User_message.to_string
+    |> fun m -> `Msg m
+  in
+  let open Result.O in
+  let* atom = atom_parser s in
+  let* _ = Lib_name.Local.of_string s |> Result.map_error ~f:err_msg in
+  Ok atom
+
+let atom_conv = Arg.conv (atom_parser, atom_printer)
+
+let component_name_conv = Arg.conv (component_name_parser, atom_printer)
+
+let public_name_conv =
+  let open Component.Options in
+  let parser = function
+    | "" -> Ok Use_name
+    | s -> component_name_parser s |> Result.map ~f:(fun a -> Public_name a)
+  in
+  let printer ppf public_name =
+    Format.pp_print_string ppf (public_name_to_string public_name)
+  in
+  Arg.conv (parser, printer)
+
+(** {2 Status reporting} *)
+
+let print_completion kind name =
+  let open Pp.O in
+  Console.print_user_message
+    (User_message.make
+       [ Pp.tag (Pp.verbatim "Success") ~tag:User_message.Style.Ok
+         ++ Pp.textf ": initialized %s component named " (Kind.to_string kind)
+         ++ Pp.tag
+              (Pp.verbatim (Dune_lang.Atom.to_string name))
+              ~tag:User_message.Style.Kwd
+       ])
+
+(** {1 CLI} *)
+
 let doc = "Initialize dune components"
 
 let man =
@@ -57,61 +113,68 @@ let term =
   and+ kind =
     (* TODO(shonfeder): Replace with nested subcommand once we have support for
        that *)
-    Arg.(
-      required
-      & pos 0 (some (enum Kind.commands)) None
-      & info [] ~docv:"INIT_KIND")
-  and+ name = Arg.(required & pos 1 (some string) None & info [] ~docv:"NAME")
-  and+ path = Arg.(value & pos 2 (some string) None & info [] ~docv:"PATH")
+    let docv = "INIT_KIND" in
+    Arg.(required & pos 0 (some (enum Kind.commands)) None & info [] ~docv)
+  and+ name =
+    let docv = "NAME" in
+    Arg.(required & pos 1 (some component_name_conv) None & info [] ~docv)
+  and+ path =
+    let docv = "PATH" in
+    Arg.(value & pos 2 (some string) None & info [] ~docv)
   and+ libraries =
-    Arg.(
-      value
-      & opt (list string) []
-      & info [ "libs" ] ~docv:"LIBRARIES"
-          ~doc:"Libraries on which the component depends")
+    let docv = "LIBRARIES" in
+    let doc =
+      "A comma separated list of libraries on which the component depends"
+    in
+    Arg.(value & opt (list component_name_conv) [] & info [ "libs" ] ~docv ~doc)
   and+ pps =
-    Arg.(
-      value
-      & opt (list string) []
-      & info [ "ppx" ] ~docv:"PREPROCESSORS"
-          ~doc:"ppx preprocessors used by the component")
+    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)
   and+ public =
     (* TODO(shonfeder): Move to subcommands {lib, exe} once implemented *)
+    let docv = "PUBLIC_NAME" in
+    let doc =
+      "If called with an argument, make the component public under the given \
+       PUBLIC_NAME. If supplied without an argument, use NAME."
+    in
     Arg.(
       value
-      & opt ~vopt:(Some "") (some string) None
-      & info [ "public" ] ~docv:"PUBLIC_NAME"
-          ~doc:
-            "If called with an argument, make the component public under the \
-             given PUBLIC_NAME. If supplied without an argument, use NAME.")
+      & opt ~vopt:(Some Component.Options.Use_name) (some public_name_conv) None
+      & info [ "public" ] ~docv ~doc)
   and+ inline_tests =
-    (* TODO Move to subcommand lib once implemented *)
-    Arg.(
-      value & flag
-      & info [ "inline-tests" ] ~docv:"USE_INLINE_TESTS"
-          ~doc:
-            "Whether to use inline tests. Only applicable for $(b,library) and \
-             $(b,project) components.")
+    (* TODO(shonfeder): Move to subcommand [lib] once implemented *)
+    let docv = "USE_INLINE_TESTS" in
+    let doc =
+      "Whether to use inline tests. Only applicable for $(b,library) and \
+       $(b,project) components."
+    in
+    Arg.(value & flag & info [ "inline-tests" ] ~docv ~doc)
   and+ template =
+    let docv = "PROJECT_KIND" in
+    let doc =
+      "The kind of project to initialize. Valid options are $(b,e[xecutable]) \
+       or $(b,l[ibrary]). Defaults to $(b,executable). Only applicable for \
+       $(b,project) components."
+    in
     Arg.(
       value
       & opt (some (enum Component.Options.Project.Template.commands)) None
-      & info [ "kind" ] ~docv:"PROJECT_KIND"
-          ~doc:
-            "The kind of project to initialize. Valid options are \
-             $(b,e[xecutable]) or $(b,l[ibrary]). Defaults to $(b,executable). \
-             Only applicable for $(b,project) components.")
+      & info [ "kind" ] ~docv ~doc)
   and+ pkg =
+    let docv = "PACKAGE_MANAGER" in
+    let doc =
+      "Which package manager to use. Valid options are $(b,o[pam]) or \
+       $(b,e[sy]). Defaults to $(b,opam). Only applicable for $(b,project) \
+       components."
+    in
     Arg.(
       value
       & opt (some (enum Component.Options.Project.Pkg.commands)) None
-      & info [ "pkg" ] ~docv:"PACKAGE_MANAGER"
-          ~doc:
-            "Which package manager to use. Valid options are $(b,o[pam]) or \
-             $(b,e[sy]). Defaults to $(b,opam). Only applicable for \
-             $(b,project) components.")
+      & info [ "pkg" ] ~docv ~doc)
   in
-  validate_component_name name;
   Common.set_common common_term ~targets:[];
   let open Component in
   let context = Init_context.make path in

src/dune/dune_init.ml

@@ -193,19 +193,29 @@ module Component = struct
   module Options = struct
     module Common = struct
       type t =
-        { name : string
-        ; libraries : string list
-        ; pps : string list
+        { name : Dune_lang.Atom.t
+        ; libraries : Dune_lang.Atom.t list
+        ; pps : Dune_lang.Atom.t list
         }
     end
 
+    (** TODO(shonfeder): Use separate types for executables and libs (which
+        would use Lib_name.t) *)
+    type public_name =
+      | Use_name
+      | Public_name of Dune_lang.Atom.t
+
+    let public_name_to_string = function
+      | Use_name -> "<default>"
+      | Public_name p -> Dune_lang.Atom.to_string p
+
     module Executable = struct
-      type t = { public : string option }
+      type t = { public : public_name option }
     end
 
     module Library = struct
       type t =
-        { public : string option
+        { public : public_name option
         ; inline_tests : bool
         }
     end
@@ -271,11 +281,12 @@ module Component = struct
     open Dune_lang
 
     module Field = struct
-      let atoms = List.map ~f:atom
+      let atoms : Atom.t list -> Dune_lang.t list =
+        List.map ~f:(fun x -> Atom x)
 
-      let public_name name = List [ atom "public_name"; atom name ]
+      let public_name name = List [ atom "public_name"; Atom name ]
 
-      let name name = List [ atom "name"; atom name ]
+      let name name = List [ atom "name"; Atom name ]
 
       let inline_tests = List [ atom "inline_tests" ]
 
@@ -288,11 +299,9 @@ module Component = struct
         | args -> [ f args ]
 
       let common (options : Options.Common.t) =
-        let optional_fields =
-          optional_field ~f:libraries options.libraries
-          @ optional_field ~f:pps options.pps
-        in
-        name options.name :: optional_fields
+        name options.name
+        :: ( optional_field ~f:libraries options.libraries
+           @ optional_field ~f:pps options.pps )
     end
 
     let make kind common_options fields =
@@ -309,21 +318,25 @@ module Component = struct
         elem :: set
 
     let public_name_field ~default = function
-      | None -> []
-      | Some "" -> [ Field.public_name default ]
-      | Some n -> [ Field.public_name n ]
+      | (None : Options.public_name option) -> []
+      | Some Use_name -> [ Field.public_name default ]
+      | Some (Public_name name) -> [ Field.public_name name ]
 
     let executable (common : Options.Common.t) (options : Options.Executable.t)
         =
       let public_name = public_name_field ~default:common.name options.public in
-      make "executable" { common with name = "main" } public_name
+      make "executable" common public_name
 
     let library (common : Options.Common.t) (options : Options.Library.t) =
       let common, inline_tests =
         if not options.inline_tests then
           (common, [])
         else
-          let pps = add_to_list_set "ppx_inline_test" common.pps in
+          let pps =
+            add_to_list_set
+              (Dune_lang.Atom.of_string "ppx_inline_test")
+              common.pps
+          in
           ({ common with pps }, [ Field.inline_tests ])
       in
       let public_name = public_name_field ~default:common.name options.public in
@@ -344,7 +357,7 @@ module Component = struct
         |> add_stanza_to_dune_file ~project:context.project ~dir
       in
       let bin_ml =
-        let name = "main.ml" in
+        let name = sprintf "%s.ml" (Dune_lang.Atom.to_string common.name) in
         let content = sprintf "let () = print_endline \"Hello, World!\"\n" in
         File.make_text dir name content
       in
@@ -368,7 +381,7 @@ module Component = struct
         |> add_stanza_to_dune_file ~project:context.project ~dir
       in
       let test_ml =
-        let name = sprintf "%s.ml" common.name in
+        let name = sprintf "%s.ml" (Dune_lang.Atom.to_string common.name) in
         let content = "" in
         File.make_text dir name content
       in
@@ -398,8 +411,9 @@ module Component = struct
         in
         bin
           { context = { context with dir = Path.relative dir "bin" }
-          ; options = { public = Some common.name }
-          ; common = { common with libraries }
+          ; options = { public = Some (Options.Public_name common.name) }
+          ; common =
+              { common with libraries; name = Dune_lang.Atom.of_string "main" }
           }
       in
       bin_target @ lib_target @ test_target
@@ -410,7 +424,9 @@ module Component = struct
         src
           { context = { context with dir = Path.relative dir "lib" }
           ; options =
-              { public = Some common.name; inline_tests = options.inline_tests }
+              { public = Some (Options.Public_name common.name)
+              ; inline_tests = options.inline_tests
+              }
           ; common
           }
       in
@@ -426,8 +442,13 @@ module Component = struct
     let proj
         ({ context; common; options } as opts : Options.Project.t Options.t) =
       let ({ template; pkg; _ } : Options.Project.t) = options in
-      let dir = Path.relative context.dir common.name in
-      let name = Package.Name.parse_string_exn (Loc.none, common.name) in
+      let dir =
+        Path.relative context.dir (Dune_lang.Atom.to_string common.name)
+      in
+      let name =
+        Package.Name.parse_string_exn
+          (Loc.none, Dune_lang.Atom.to_string common.name)
+      in
       let proj_target =
         let files =
           match (pkg : Options.Project.Pkg.t) with
@@ -475,24 +496,3 @@ module Component = struct
     in
     List.concat_map ~f:create target |> List.iter ~f:report_uncreated_file
 end
-
-let validate_component_name name =
-  match Lib_name.Local.of_string name with
-  | Ok _ -> ()
-  | _ ->
-    User_error.raise
-      [ Pp.textf
-          "A component named '%s' cannot be created because it is an invalid \
-           library name."
-          name
-      ]
-      ~hints:[ Lib_name.Local.valid_format_doc ]
-
-let print_completion kind name =
-  let open Pp.O in
-  Console.print_user_message
-    (User_message.make
-       [ Pp.tag (Pp.verbatim "Success") ~tag:User_message.Style.Ok
-         ++ Pp.textf ": initialized %s component named " (Kind.to_string kind)
-         ++ Pp.tag (Pp.verbatim name) ~tag:User_message.Style.Kwd
-       ])