From d564bd29d227344fa5cc230de69dbac0ab831faf Mon Sep 17 00:00:00 2001 From: Ali Caglayan Date: Sun, 4 Dec 2022 18:31:51 +0100 Subject: [PATCH] WIP weird error when compiling executable Signed-off-by: Ali Caglayan --- bin/dune | 33 +++++++++++ bin/dune_cmd.ml | 88 ++++++++++++++++++++++++++++ bin/dune_cmd.mli | 4 ++ bin/main.ml | 87 +-------------------------- boot/libs.ml | 1 + doc/man/dune | 11 ++++ doc/man/man_rules.ml | 43 ++++++++++++++ vendor/cmdliner/src/cmdliner.mli | 7 +++ vendor/cmdliner/src/cmdliner_cmd.ml | 2 + vendor/cmdliner/src/cmdliner_cmd.mli | 2 + 10 files changed, 193 insertions(+), 85 deletions(-) create mode 100644 bin/dune_cmd.ml create mode 100644 bin/dune_cmd.mli create mode 100644 doc/man/dune create mode 100644 doc/man/man_rules.ml diff --git a/bin/dune b/bin/dune index e11bf9e5f73..f4ba9dc8711 100644 --- a/bin/dune +++ b/bin/dune @@ -1,10 +1,43 @@ +(library + (name dune_bin) + (modules :standard \ main) + (libraries + memo + ocaml + dune_lang + fiber + stdune + dune_console + unix + dune_metrics + dune_digest + dune_cache + dune_cache_storage + dune_graph + dune_rules + dune_engine + dune_util + dune_upgrader + cmdliner + threads.posix + build_info + dune_config + chrome_trace + dune_stats + csexp + csexp_rpc + dune_rpc_impl + dune_rpc_private)) + (executable (name main) (public_name dune) (package dune) + (modules main) (enabled_if (<> %{profile} dune-bootstrap)) (libraries + dune_bin memo ocaml dune_lang diff --git a/bin/dune_cmd.ml b/bin/dune_cmd.ml new file mode 100644 index 00000000000..1f2aece4f2c --- /dev/null +++ b/bin/dune_cmd.ml @@ -0,0 +1,88 @@ +open! Stdune +open Import + +let all : _ Cmdliner.Cmd.t list = + let terms = + [ Installed_libraries.command + ; External_lib_deps.command + ; Build_cmd.build + ; Build_cmd.runtest + ; Build_cmd.fmt + ; command_alias Build_cmd.runtest Build_cmd.runtest_term "test" + ; Clean.command + ; Install_uninstall.install + ; Install_uninstall.uninstall + ; Exec.command + ; Subst.command + ; Print_rules.command + ; Utop.command + ; Promotion.promote + ; Printenv.command + ; Help.command + ; Format_dune_file.command + ; Upgrade.command + ; Cache.command + ; Describe.command + ; Top.command + ; Ocaml_merlin.command + ; Shutdown.command + ; Diagnostics.command + ] + in + let groups = + [ Ocaml_cmd.group + ; Coq.group + ; Rpc.group + ; Internal.group + ; Init.group + ; Promotion.group + ] + in + terms @ groups + +(* Short reminders for the most used and useful commands *) +let common_commands_synopsis = + Common.command_synopsis + [ "build [--watch]" + ; "runtest [--watch]" + ; "exec NAME" + ; "utop [DIR]" + ; "install" + ; "init project NAME [PATH] [--libs=l1,l2 --ppx=p1,p2 --inline-tests]" + ] + +let info = + let doc = "composable build system for OCaml" in + Cmd.info "dune" ~doc ~envs:Common.envs + ~version: + (match Build_info.V1.version () with + | None -> "n/a" + | Some v -> Build_info.V1.Version.to_string v) + ~man: + [ `Blocks common_commands_synopsis + ; `S "DESCRIPTION" + ; `P + {|Dune is a build system designed for OCaml projects only. It + focuses on providing the user with a consistent experience and takes + care of most of the low-level details of OCaml compilation. All you + have to do is provide a description of your project and Dune will + do the rest. + |} + ; `P + {|The scheme it implements is inspired from the one used inside Jane + Street and adapted to the open source world. It has matured over a + long time and is used daily by hundreds of developers, which means + that it is highly tested and productive. + |} + ; `Blocks Common.help_secs + ; Common.examples + [ ("Initialise a new project named `foo'", "dune init project foo") + ; ("Build all targets in the current source tree", "dune build") + ; ("Run the executable named `bar'", "dune exec bar") + ; ("Run all tests in the current source tree", "dune runtest") + ; ("Install all components defined in the project", "dune install") + ; ("Remove all build artefacts", "dune clean") + ] + ] + +let cmd = Cmd.group info all diff --git a/bin/dune_cmd.mli b/bin/dune_cmd.mli new file mode 100644 index 00000000000..7393e928b0f --- /dev/null +++ b/bin/dune_cmd.mli @@ -0,0 +1,4 @@ +open! Stdune +open Import + +val cmd : unit Cmd.t diff --git a/bin/main.ml b/bin/main.ml index a101b2608f6..9d185770ac8 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -1,91 +1,8 @@ open! Stdune +open Dune_bin open Import -let all : _ Cmdliner.Cmd.t list = - let terms = - [ Installed_libraries.command - ; External_lib_deps.command - ; Build_cmd.build - ; Build_cmd.runtest - ; Build_cmd.fmt - ; command_alias Build_cmd.runtest Build_cmd.runtest_term "test" - ; Clean.command - ; Install_uninstall.install - ; Install_uninstall.uninstall - ; Exec.command - ; Subst.command - ; Print_rules.command - ; Utop.command - ; Promotion.promote - ; Printenv.command - ; Help.command - ; Format_dune_file.command - ; Upgrade.command - ; Cache.command - ; Describe.command - ; Top.command - ; Ocaml_merlin.command - ; Shutdown.command - ; Diagnostics.command - ] - in - let groups = - [ Ocaml_cmd.group - ; Coq.group - ; Rpc.group - ; Internal.group - ; Init.group - ; Promotion.group - ] - in - terms @ groups - -(* Short reminders for the most used and useful commands *) -let common_commands_synopsis = - Common.command_synopsis - [ "build [--watch]" - ; "runtest [--watch]" - ; "exec NAME" - ; "utop [DIR]" - ; "install" - ; "init project NAME [PATH] [--libs=l1,l2 --ppx=p1,p2 --inline-tests]" - ] - -let info = - let doc = "composable build system for OCaml" in - Cmd.info "dune" ~doc ~envs:Common.envs - ~version: - (match Build_info.V1.version () with - | None -> "n/a" - | Some v -> Build_info.V1.Version.to_string v) - ~man: - [ `Blocks common_commands_synopsis - ; `S "DESCRIPTION" - ; `P - {|Dune is a build system designed for OCaml projects only. It - focuses on providing the user with a consistent experience and takes - care of most of the low-level details of OCaml compilation. All you - have to do is provide a description of your project and Dune will - do the rest. - |} - ; `P - {|The scheme it implements is inspired from the one used inside Jane - Street and adapted to the open source world. It has matured over a - long time and is used daily by hundreds of developers, which means - that it is highly tested and productive. - |} - ; `Blocks Common.help_secs - ; Common.examples - [ ("Initialise a new project named `foo'", "dune init project foo") - ; ("Build all targets in the current source tree", "dune build") - ; ("Run the executable named `bar'", "dune exec bar") - ; ("Run all tests in the current source tree", "dune runtest") - ; ("Install all components defined in the project", "dune install") - ; ("Remove all build artefacts", "dune clean") - ] - ] - -let cmd = Cmd.group info all +let cmd = Dune_cmd.cmd let exit_and_flush code = Console.finish (); diff --git a/boot/libs.ml b/boot/libs.ml index 806d9d4e278..43b3a4fba9e 100644 --- a/boot/libs.ml +++ b/boot/libs.ml @@ -57,6 +57,7 @@ let local_libraries = Some "Build_info_data") ; ("src/csexp_rpc", Some "Csexp_rpc", false, None) ; ("src/dune_rpc_impl", Some "Dune_rpc_impl", false, None) + ; ("bin", Some "Dune_bin", false, None) ] let link_flags = diff --git a/doc/man/dune b/doc/man/dune new file mode 100644 index 00000000000..178bafc6444 --- /dev/null +++ b/doc/man/dune @@ -0,0 +1,11 @@ +(executable + (name man_rules) + (libraries dune_bin cmdliner stdune dune_rules)) + +; (rule +; (mode promote) +; (aliases default doc check) +; (action +; (with-stdout-to +; dune.1 +; (run %{bin:dune} --help=plain)))) diff --git a/doc/man/man_rules.ml b/doc/man/man_rules.ml new file mode 100644 index 00000000000..60bd35ed2da --- /dev/null +++ b/doc/man/man_rules.ml @@ -0,0 +1,43 @@ +open Stdune +(* open Dune_bin.Import *) + +let man_rule (cmd : string list) = + let action = + String.concat ~sep:" " + @@ + match cmd with + | "dune" :: sc -> "%{dune.exe}" :: sc + | _ -> + Code_error.raise + "Non-dune command detected. This is not supported yet, please add a \ + case here." + [] + in + let dash_seperated = String.concat ~sep:"-" cmd in + sprintf + {| + +(rule + (mode promote) + (aliases default doc check) + (action + (with-stdout-to + %s.1 + (run %s --help=plain)))) +|} + dash_seperated action + +let rec all_commands_of_cmdliner rev_cmd_acc (cmd : unit Cmdliner.Cmd.t) = + match Cmdliner.Cmd.get_subcommands cmd with + | [] -> [ Cmdliner.Cmd.name cmd :: rev_cmd_acc ] + | cmds -> + List.rev_map cmds + ~f:(all_commands_of_cmdliner (Cmdliner.Cmd.name cmd :: rev_cmd_acc)) + |> List.flatten + +let main () = + all_commands_of_cmdliner [] Dune_bin.Dune_cmd.cmd + |> List.rev_map ~f:man_rule + |> List.iter ~f:(Printf.printf "%s") + +let () = main () diff --git a/vendor/cmdliner/src/cmdliner.mli b/vendor/cmdliner/src/cmdliner.mli index c6d179a9773..a247dc2fe71 100644 --- a/vendor/cmdliner/src/cmdliner.mli +++ b/vendor/cmdliner/src/cmdliner.mli @@ -773,6 +773,13 @@ module Cmd : sig specification of the command line: we can't tell apart a positional argument from the value of an unknown optional argument. *) + + val get_subcommands : 'a t -> 'a t list + (** [get_subcommands cmd] returns the list of subcommands of [cmd]. + + We use this in Dune so that + *) + end (** Terms for command line arguments. diff --git a/vendor/cmdliner/src/cmdliner_cmd.ml b/vendor/cmdliner/src/cmdliner_cmd.ml index 5a156f3fdd6..695100bd7a9 100644 --- a/vendor/cmdliner/src/cmdliner_cmd.ml +++ b/vendor/cmdliner/src/cmdliner_cmd.ml @@ -29,6 +29,8 @@ let group ?default i cmds = let name c = Cmdliner_info.Cmd.name (get_info c) +let get_subcommands = function Cmd _ -> [] | Group (_, (_, cs)) -> cs + (*--------------------------------------------------------------------------- Copyright (c) 2022 The cmdliner programmers diff --git a/vendor/cmdliner/src/cmdliner_cmd.mli b/vendor/cmdliner/src/cmdliner_cmd.mli index 54da1535d8a..6a5d683c927 100644 --- a/vendor/cmdliner/src/cmdliner_cmd.mli +++ b/vendor/cmdliner/src/cmdliner_cmd.mli @@ -23,6 +23,8 @@ val group : ?default:'a Cmdliner_term.t -> info -> 'a t list -> 'a t val name : 'a t -> string val get_info : 'a t -> info +val get_subcommands : 'a t -> 'a t list + (*--------------------------------------------------------------------------- Copyright (c) 2022 The cmdliner programmers