diff --git a/CHANGES.md b/CHANGES.md index e35f1565c6d..de025bdf0aa 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -24,6 +24,9 @@ 1.10.0 (04/06/2019) ------------------- +- Add `$ dune init project` subcommand to create project boilerplate according + to a common template. (#2185, fixes #159, @shonfeder) + - Restricted the set of variables available for expansion in the destination filename of `install` stanza to simplify implementation and avoid dependency cycles. (#2073, @aalekseyev, @diml) diff --git a/bin/init.ml b/bin/init.ml index 397743e02d6..d5a7350dd0a 100644 --- a/bin/init.ml +++ b/bin/init.ml @@ -4,7 +4,7 @@ open Import open Dune.Dune_init (* TODO(shonfeder): Remove when nested subcommands are available *) -let validate_component_options kind ~unsupported_options = +let validate_component_options kind unsupported_options = let report_invalid_option = function | _, false -> () (* The option wasn't supplied *) | option_name, true -> @@ -16,10 +16,12 @@ let validate_component_options kind ~unsupported_options = let doc = "Initialize dune components" let man = [ `S "DESCRIPTION" - ; `P {|$(b,dune init {lib,exe,test} NAME [PATH]) initialize a new dune - component of the specified kind, named $(b,NAME), with fields - determined by the supplied options.|} - ; `P {|If the optional $(b,PATH) is provided, the project will be created + ; `P {|$(b,dune init {library,executable,test,project} NAME [PATH]) initialize + a new dune component of the specified kind, named $(b,NAME), with + fields determined by the supplied options.|} + ; `P {|Any prefix of the component kinds can be supplied, e.g., $(b,dune init + proj myproject).|} + ; `P {|If the optional $(b,PATH) is provided, the component will be created there. Otherwise, it is created in the current working directory.|} ; `P {|The command can be used to add stanzas to existing dune files as well as for creating new dune files and basic component templates.|} @@ -81,32 +83,84 @@ let term = & info ["inline-tests"] ~docv:"USE_INLINE_TESTS" ~doc:"Whether to use inline tests. \ - Only applicable for lib components.") + Only applicable for $(b,library) and $(b,project) components.") + and+ template = + 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.") + and+ pkg = + 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.") + in validate_component_name name; - Common.set_common common_term ~targets:[]; + let open Component in let context = Init_context.make path in - let common : Options.common = { name; libraries; pps } in + let common : Options.Common.t = { name; libraries; pps } in + let given_public = Option.is_some public in + let given_pkg = Option.is_some pkg in + let given_template = Option.is_some template in + + let pkg = Option.value pkg ~default:Options.Project.Pkg.Opam in + let template = Option.value template ~default:Options.Project.Template.Exec in + + (* for the [kind] of initialization *) + let check_unsupported_options = validate_component_options kind in + begin match kind with - | Kind.Library -> - init @@ Library { context; common; options = {public; inline_tests} } | Kind.Executable -> - let unsupported_options = - ["inline-tests", inline_tests] - in - validate_component_options kind ~unsupported_options; - init @@ Executable { context; common; options = {public} } + check_unsupported_options [ "inline-tests", inline_tests + ; "kind", given_template + ; "pkg", given_pkg + ]; + init @@ Executable { context + ; common + ; options = {public} + } + | Kind.Library -> + check_unsupported_options [ "kind", given_template + ; "pkg", given_pkg + ]; + init @@ Library { context + ; common + ; options = {public; inline_tests} + } + | Kind.Project -> + check_unsupported_options ["public", given_public + ]; + init @@ Project { context + ; common + ; options = { inline_tests; pkg; template } + } | Kind.Test -> - let unsupported_options = - [ "public", given_public - ; "inline-tests", inline_tests] - in - validate_component_options kind ~unsupported_options; - init @@ Test { context; common; options = () } + check_unsupported_options [ "public", given_public + ; "inline-tests", inline_tests + ; "kind", given_template + ; "pkg", given_pkg + ]; + init @@ Test { context + ; common + ; options = () + } end; print_completion kind name diff --git a/doc/usage.rst b/doc/usage.rst index 87416b48ab1..1d02c0c9b5e 100644 --- a/doc/usage.rst +++ b/doc/usage.rst @@ -14,12 +14,32 @@ change. Dune's ``init`` subcommand provides limited support for generating dune file stanzas and folder structures to define components. ``dune init`` can be used to -quickly add new libraries, tests, or executables without having to manually edit -a dune file, or it can be composed to programmatically generate parts of a -multi-component project. +quickly add new projects, libraries, tests, or executables without having to +manually create dune files, or it can be composed to programmatically generate +parts of a multi-component project. -For example, to add a new executable to a ``dune`` file in the current directory -(creating the file if necessary), you can run +Initializing a project +---------------------- + +To initialize a new ``dune`` project that uses the ``base`` and ``cmdliner``, +libraries and supports inline tests, you can run + +.. code:: bash + + $ dune init proj myproj --libs base,cmdliner --inline-tests --ppx ppx_inline_test + +This will create a new directory called ``myproj`` including sub directories and +``dune`` files for library, executable, and test components. Each component's +``dune`` file will also include the declarations required for the given +dependencies. + +This is the quickest way to get a basic ``dune`` project up and building. + +Initializing an executable +----------------------------- + +To add a new executable to a ``dune`` file in the current directory +(creating the file if necessary), run .. code:: bash @@ -35,7 +55,10 @@ This will add the following stanza to the ``dune`` file: (preprocess (pps ppx_deriving))) -Or, to create a new directory ``src``, initialized as a library, you can run: +Initializing a library +---------------------- + +To create a new directory ``src``, initialized as a library, can run: .. code:: bash diff --git a/src/dune_init.ml b/src/dune_init.ml index cd125d53c06..bc95c6f2365 100644 --- a/src/dune_init.ml +++ b/src/dune_init.ml @@ -10,18 +10,21 @@ module Kind = struct type t = | Executable | Library + | Project | Test let to_string = function | Executable -> "executable" | Library -> "library" + | Project -> "project" | Test -> "test" let pp ppf t = Format.pp_print_string ppf (to_string t) let commands = - [ "exe", Executable - ; "lib", Library + [ "executable", Executable + ; "library", Library + ; "project", Project ; "test", Test ] end @@ -50,7 +53,7 @@ module File = struct let full_path = function | Dune {path; name; _} | Text {path; name; _} -> - Path.relative path name + Path.relative path name (** Inspection and manipulation of stanzas in a file *) module Stanza = struct @@ -175,36 +178,82 @@ end module Component = struct module Options = struct - type common = - { name : string - ; libraries : string list - ; pps : string list - } - type executable = - { public: string option - } + module Common = struct + type t = + { name : string + ; libraries : string list + ; pps : string list + } + end - type library = - { public: string option - ; inline_tests: bool - } + module Executable = struct + type t = + { public: string option + } + end + + module Library = struct + type t = + { public: string option + ; inline_tests: bool + } + end + + module Project = struct + module Template = struct + type t = + | Exec + | Lib + (* TODO(shonfeder) Add custom templates *) + + let of_string = function + | "executable" -> Some Exec + | "library" -> Some Lib + | _ -> None + + let commands = + [ "executable", Exec + ; "library", Lib + ] + end - (* NOTE: no options supported yet *) - type test = unit + module Pkg = struct + type t = + | Opam + | Esy + + let commands = + [ "opam", Opam + ; "esy", Esy + ] + end + + type t = + { template: Template.t + ; inline_tests: bool + ; pkg: Pkg.t + } + end + + module Test = struct + type t = unit + end type 'options t = { context : Init_context.t - ; common : common + ; common : Common.t ; options : 'options } - end + end (* Options *) type 'options t = - | Executable : Options.executable Options.t -> Options.executable t - | Library : Options.library Options.t -> Options.library t - | Test : Options.test Options.t -> Options.test t + | Executable : Options.Executable.t Options.t -> Options.Executable.t t + | Library : Options.Library.t Options.t -> Options.Library.t t + | Project : Options.Project.t Options.t -> Options.Project.t t + | Test : Options.Test.t Options.t -> Options.Test.t t + (** Internal representation of the files comprising a component *) type target = { dir : Path.t ; files : File.t list @@ -226,7 +275,7 @@ module Component = struct | [] -> [] | args -> [f args] - let common (options : Options.common) = + let common (options : Options.Common.t) = let optional_fields = optional_field ~f:libraries options.libraries @ optional_field ~f:pps options.pps @@ -253,19 +302,19 @@ module Component = struct | Some "" -> [Field.public_name default] | Some n -> [Field.public_name n] - let executable (common : Options.common) (options : Options.executable) = + 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 - let library (common : Options.common) (options: Options.library) = + 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_tests" common.pps + add_to_list_set "ppx_inline_test" common.pps in ({common with pps}, [Field.inline_tests]) in @@ -274,7 +323,7 @@ module Component = struct in make "library" common (public_name @ inline_tests) - let test common ((): Options.test) = + let test common ((): Options.Test.t) = make "test" common [] end @@ -283,52 +332,112 @@ module Component = struct File.load_dune_file ~path:dir |> File.Stanza.add project stanza - let bin ({context; common; options} : Options.executable Options.t) = - let dir = context.dir in - let bin_dune = - Stanza_cst.executable common options - |> add_stanza_to_dune_file ~project:context.project ~dir - in - let bin_ml = - let name = "main.ml" in - let content = sprintf "let () = print_endline \"Hello, World!\"\n" in - File.make_text dir name content - in - let files = [bin_dune; bin_ml] in - {dir; files} - - let src ({context; common; options} : Options.library Options.t) = - let dir = context.dir in - let lib_dune = - Stanza_cst.library common options - |> add_stanza_to_dune_file ~project:context.project ~dir - in - let files = [lib_dune] in - {dir; files} - - let test ({context; common; options}: Options.test Options.t) = - (* Marking the current absence of test-specific options *) - let dir = context.dir in - let test_dune = - Stanza_cst.test common options - |> add_stanza_to_dune_file ~project:context.project ~dir - in - let test_ml = - let name = sprintf "%s.ml" common.name in - let content = "" in - File.make_text dir name content - in - let files = [test_dune; test_ml] in - {dir; files} + module Make = struct + let bin ({context; common; options} : Options.Executable.t Options.t) = + let dir = context.dir in + let bin_dune = + Stanza_cst.executable common options + |> add_stanza_to_dune_file ~project:context.project ~dir + in + let bin_ml = + let name = "main.ml" in + let content = sprintf "let () = print_endline \"Hello, World!\"\n" in + File.make_text dir name content + in + let files = [bin_dune; bin_ml] in + [{dir; files}] + + let src ({context; common; options} : Options.Library.t Options.t) = + let dir = context.dir in + let lib_dune = + Stanza_cst.library common options + |> add_stanza_to_dune_file ~project:context.project ~dir + in + let files = [lib_dune] in + [{dir; files}] + + let test ({context; common; options}: Options.Test.t Options.t) = + (* Marking the current absence of test-specific options *) + let dir = context.dir in + let test_dune = + Stanza_cst.test common options + |> add_stanza_to_dune_file ~project:context.project ~dir + in + let test_ml = + let name = sprintf "%s.ml" common.name in + let content = "" in + File.make_text dir name content + in + let files = [test_dune; test_ml] in + [{dir; files}] + + let proj_exec dir ({context; common; options} : Options.Project.t Options.t) = + let lib_target = + src { context = {context with dir = Path.relative dir "lib"} + ; options = {public = None; inline_tests = options.inline_tests} + ; common + } + in + let test_target = + test { context = {context with dir = Path.relative dir "test"} + ; options = () + ; common + } + in + let bin_target = + (* Add the lib_target as a library to the executable*) + 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 common. name} + ; common = {common with libraries} + } + in + bin_target @ lib_target @ test_target + + let proj_lib dir ({context; common; options} : Options.Project.t Options.t) = + let lib_target = + src { context = {context with dir = Path.relative dir "lib"} + ; options = {public = Some common.name; inline_tests = options.inline_tests} + ; common + } + in + let test_target = + test { context = {context with dir = Path.relative dir "test"} + ; options = () + ; common + } + in + lib_target @ test_target + + 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 = common.name in + let proj_target = + let files = + match (pkg : Options.Project.Pkg.t) with + | Opam -> [File.make_text dir (name ^ ".opam") ""] + | Esy -> [File.make_text dir "package.json" ""] + in + {dir; files} + in + let component_targets = + match (template : Options.Project.Template.t) with + | Exec -> proj_exec dir opts + | Lib -> proj_lib dir opts + in + proj_target :: component_targets + end let report_uncreated_file = function | Ok _ -> () | Error path -> Errors.kerrf ~f:print_to_console - "@{Warning@}: file @{%a@} was not created \ - because it already exists\n" - Path.pp path + "@{Warning@}: file @{%a@} was not created \ + because it already exists\n" + Path.pp path + (** Creates a component, writing the files to disk *) let create target = File.create_dir target.dir; List.map ~f:File.write target.files @@ -336,11 +445,12 @@ module Component = struct let init (type options) (t : options t) = let target = match t with - | Executable params -> bin params - | Library params -> src params - | Test params -> test params + | Executable params -> Make.bin params + | Library params -> Make.src params + | Project params -> Make.proj params + | Test params -> Make.test params in - create target + List.concat_map ~f:create target |> List.iter ~f:report_uncreated_file end diff --git a/src/dune_init.mli b/src/dune_init.mli index d148319efdc..e4de4ba65fe 100644 --- a/src/dune_init.mli +++ b/src/dune_init.mli @@ -6,6 +6,7 @@ module Kind : sig type t = | Executable | Library + | Project | Test val to_string : t -> string @@ -29,35 +30,72 @@ module Component : sig (** Options determining the details of a generated component *) module Options : sig - type common = - { name: string - ; libraries: string list - ; pps: string list - } + module Common : sig + type t = + { name : string + ; libraries : string list + ; pps : string list + } + end - type executable = - { public: string option - } + module Executable : sig + type t = + { public : string option + } + end - type library = - { public: string option - ; inline_tests: bool - } + module Library : sig + type t = + { public : string option + ; inline_tests : bool + } + end + + module Test : sig + (** NOTE: no options supported yet *) + type t = unit + end + + module Project : sig + + module Template : sig + type t = + | Exec + | Lib + + val of_string : string -> t option + val commands : (string * t) list + end + + (** The package manager used for a project *) + module Pkg : sig + type t = + | Opam + | Esy + + val commands : (string * t) list + end - (** NOTE: no options supported yet *) - type test = unit + type t = + { template : Template.t + ; inline_tests: bool + ; pkg : Pkg.t + } + end type 'a t = { context : Init_context.t - ; common : common + ; common : Common.t ; options : 'a } end + (** The supported types of components *) type 'options t = - | Executable : Options.executable Options.t -> Options.executable t - | Library : Options.library Options.t -> Options.library t - | Test : Options.test Options.t -> Options.test t + | Executable : Options.Executable.t Options.t -> Options.Executable.t t + | Library : Options.Library.t Options.t -> Options.Library.t t + | Project : Options.Project.t Options.t -> Options.Project.t t + | Test : Options.Test.t Options.t -> Options.Test.t t (** Create or update the component specified by the ['options t], where ['options] is *) diff --git a/test/blackbox-tests/test-cases/dune-init/run.t b/test/blackbox-tests/test-cases/dune-init/run.t index 277aa01807c..a1527848257 100644 --- a/test/blackbox-tests/test-cases/dune-init/run.t +++ b/test/blackbox-tests/test-cases/dune-init/run.t @@ -37,14 +37,14 @@ Clean up library with specified public name Can add a library with inline tests - $ dune init lib test_lib ./_inline_tests_lib --inline-tests --ppx ppx_inline_tests + $ dune init lib test_lib ./_inline_tests_lib --inline-tests --ppx ppx_inline_test Success: initialized library component named test_lib $ cat ./_inline_tests_lib/dune (library (inline_tests) (name test_lib) (preprocess - (pps ppx_inline_tests))) + (pps ppx_inline_test))) Clean up library with inlines tests @@ -240,8 +240,8 @@ Will not create components with invalid names Will fail and inform user when invalid component command is given $ dune init foo blah - dune: INIT_KIND argument: invalid value `foo', expected one of `exe', `lib' - or `test' + dune: INIT_KIND argument: invalid value `foo', expected one of `executable', + `library', `project' or `test' Usage: dune init [OPTION]... INIT_KIND NAME [PATH] Try `dune init --help' or `dune --help' for more information. [1] @@ -277,3 +277,71 @@ Adding fields to existing stanzas is currently not supported (executable (name main) (libraries test_lib1)) + +Creating projects +----------------- + +Can init and build a new executable project + + $ dune init proj test_exec_proj + Success: initialized project component named test_exec_proj + + $ ls test_exec_proj/** + test_exec_proj/test_exec_proj.opam + + test_exec_proj/bin: + dune + main.ml + + test_exec_proj/lib: + dune + + test_exec_proj/test: + dune + test_exec_proj.ml + + $ cd test_exec_proj && dune build + Info: creating file dune-project with this contents: + | (lang dune 1.10) + | (name test_exec_proj) + + $ rm -rf ./test_exec_proj + +Can init and build a new library project + + $ dune init proj test_lib_proj --kind lib + Success: initialized project component named test_lib_proj + + $ ls test_lib_proj/** + test_lib_proj/test_lib_proj.opam + + test_lib_proj/lib: + dune + + test_lib_proj/test: + dune + test_lib_proj.ml + + $ cd test_lib_proj && dune build + Info: creating file dune-project with this contents: + | (lang dune 1.10) + | (name test_lib_proj) + +Can init and build a project using Esy + + $ dune init proj test_esy_proj --pkg esy + Success: initialized project component named test_esy_proj + + $ ls test_esy_proj/** + test_esy_proj/package.json + + test_esy_proj/bin: + dune + main.ml + + test_esy_proj/lib: + dune + + test_esy_proj/test: + dune + test_esy_proj.ml