From 8d0d819edf79a2e01704ac035f545d46fc5a1fa6 Mon Sep 17 00:00:00 2001 From: Alpha DIALLO Date: Tue, 27 Jun 2023 11:51:30 +0200 Subject: [PATCH 1/4] Add "dune describe entries" The need is about knowing if a private executable is going to be installed before building the project. Signed-off-by: Alpha DIALLO --- bin/describe/describe.ml | 1 + bin/describe/package_entries.ml | 24 ++ bin/describe/package_entries.mli | 4 + src/dune_rules/dune_rules.ml | 2 + src/dune_rules/install_rules.ml | 2 + src/dune_rules/install_rules.mli | 4 + src/install/entry.ml | 22 ++ src/install/entry.mli | 2 + .../test-cases/describe-package-entries.t | 218 ++++++++++++++++++ 9 files changed, 279 insertions(+) create mode 100644 bin/describe/package_entries.ml create mode 100644 bin/describe/package_entries.mli create mode 100644 test/blackbox-tests/test-cases/describe-package-entries.t diff --git a/bin/describe/describe.ml b/bin/describe/describe.ml index 55838a05833..a43137e8b6d 100644 --- a/bin/describe/describe.ml +++ b/bin/describe/describe.ml @@ -17,6 +17,7 @@ let subcommands = ; Installed_libraries.command ; Aliases_targets.Targets_cmd.command ; Aliases_targets.Aliases_cmd.command + ; Package_entries.command ] let group = diff --git a/bin/describe/package_entries.ml b/bin/describe/package_entries.ml new file mode 100644 index 00000000000..f66a941f2e6 --- /dev/null +++ b/bin/describe/package_entries.ml @@ -0,0 +1,24 @@ +open Import +open Stdune + +let term = + let+ common = Common.term + and+ context_name = Common.context_arg ~doc:"Build context to use." + and+ format = Describe_format.arg in + let config = Common.init common in + Scheduler.go ~common ~config @@ fun () -> + let open Fiber.O in + let* setup = Import.Main.setup () in + let* setup = Memo.run setup in + let super_context = Import.Main.find_scontext_exn setup ~name:context_name in + Build_system.run_exn @@ fun () -> + let open Memo.O in + Dune_rules.Install_rules.stanzas_to_entries super_context + >>| Package.Name.Map.to_dyn (fun entries -> + Dyn.List (List.map ~f:Install.Entry.Sourced.to_dyn entries)) + >>| Describe_format.print_dyn format + +let command = + let doc = "prints information about the entries per package" in + let info = Cmd.info ~doc "package-entries" in + Cmd.v info term diff --git a/bin/describe/package_entries.mli b/bin/describe/package_entries.mli new file mode 100644 index 00000000000..8e5fbcdb877 --- /dev/null +++ b/bin/describe/package_entries.mli @@ -0,0 +1,4 @@ +open Import + +(** Dune command to print out information about the entries per package.*) +val command : unit Cmd.t diff --git a/src/dune_rules/dune_rules.ml b/src/dune_rules/dune_rules.ml index 1915c92216d..06ad8165cb8 100644 --- a/src/dune_rules/dune_rules.ml +++ b/src/dune_rules/dune_rules.ml @@ -59,6 +59,8 @@ module Dialect = Dialect module Install_rules = struct let install_file = Install_rules.install_file + + let stanzas_to_entries = Install_rules.stanzas_to_entries end module For_tests = struct diff --git a/src/dune_rules/install_rules.ml b/src/dune_rules/install_rules.ml index 67b8741807c..6a2de5f2f00 100644 --- a/src/dune_rules/install_rules.ml +++ b/src/dune_rules/install_rules.ml @@ -1217,6 +1217,8 @@ let gen_install_alias sctx (package : Package.t) = Rules.Produce.Alias.add_deps install_alias (Action_builder.path install_file) +let stanzas_to_entries = Stanzas_to_entries.stanzas_to_entries + let gen_project_rules sctx project = let* () = meta_and_dune_package_rules sctx project in let* packages = Only_packages.packages_of_project project in diff --git a/src/dune_rules/install_rules.mli b/src/dune_rules/install_rules.mli index 13ca1d2cc26..fba5439226d 100644 --- a/src/dune_rules/install_rules.mli +++ b/src/dune_rules/install_rules.mli @@ -6,6 +6,10 @@ val install_file : val symlink_rules : Super_context.t -> dir:Path.Build.t -> (Subdir_set.t * Rules.t) Memo.t +val stanzas_to_entries : + Super_context.t + -> Install.Entry.Sourced.t list Dune_lang.Package_name.Map.t Memo.t + (** Generate rules for [.dune-package], [META.] files. and [.install] files. *) val gen_project_rules : Super_context.t -> Dune_project.t -> unit Memo.t diff --git a/src/install/entry.ml b/src/install/entry.ml index bb5c30e4fcc..20116d59ca8 100644 --- a/src/install/entry.ml +++ b/src/install/entry.ml @@ -95,6 +95,20 @@ type 'src t = let map_dst t ~f = { t with dst = f t.dst } +let to_dyn { src; kind; dst; section; optional } = + let open Dyn in + let dyn_of_kind = function + | `File -> String "file" + | `Directory -> String "directory" + in + record + [ ("src", Path.Build.to_dyn src) + ; ("kind", dyn_of_kind kind) + ; ("dst", Dst.to_dyn dst) + ; ("section", Section.to_dyn section) + ; ("optional", Dyn.Bool optional) + ] + module Sourced = struct type source = | User of Loc.t @@ -112,6 +126,14 @@ module Sourced = struct | Some loc -> User loc) ; entry } + + let to_dyn { source; entry } = + let open Dyn in + let source_to_dyn = function + | Dune -> String "dune" + | User loc -> Variant ("user", [ Loc.to_dyn loc ]) + in + Record [ ("source", source_to_dyn source); ("entry", to_dyn entry) ] end let compare compare_src { optional; src; dst; section; kind } t = diff --git a/src/install/entry.mli b/src/install/entry.mli index 54ac2d00d36..1f22fcd6037 100644 --- a/src/install/entry.mli +++ b/src/install/entry.mli @@ -39,6 +39,8 @@ module Sourced : sig } val create : ?loc:Loc.t -> entry -> t + + val to_dyn : t -> Dyn.t end val adjust_dst : diff --git a/test/blackbox-tests/test-cases/describe-package-entries.t b/test/blackbox-tests/test-cases/describe-package-entries.t new file mode 100644 index 00000000000..41600aa8e3f --- /dev/null +++ b/test/blackbox-tests/test-cases/describe-package-entries.t @@ -0,0 +1,218 @@ +Test for the `dune describe package-entries` command + + $ cat >dune-project < (lang dune 2.7) + > (package + > (name foo) + > (synopsis "describe package-entries")) + > (generate_opam_files) + > EOF + + $ cat >dune < (library + > (public_name foo) + > (modules foo)) + > + > (executable + > (name main) + > (libraries foo) + > (modules main)) + > + > (install + > (section bin) + > (package foo) + > (files main.exe)) + > EOF + + $ touch main.ml + $ touch foo.ml + $ touch foo.opam + + $ dune describe package-entries + ((foo + (((source dune) + (entry + ((src + (In_build_dir default/META.foo)) + (kind file) + (dst META) + (section LIB) + (optional false)))) + ((source dune) + (entry + ((src + (In_build_dir default/foo.dune-package)) + (kind file) + (dst dune-package) + (section LIB) + (optional false)))) + ((source + (user + ((pos_fname dune) + (start + ((pos_lnum 1) + (pos_bol 0) + (pos_cnum 0))) + (stop + ((pos_lnum 3) + (pos_bol 28) + (pos_cnum 43)))))) + (entry + ((src + (In_build_dir default/foo.a)) + (kind file) + (dst foo.a) + (section LIB) + (optional false)))) + ((source + (user + ((pos_fname dune) + (start + ((pos_lnum 1) + (pos_bol 0) + (pos_cnum 0))) + (stop + ((pos_lnum 3) + (pos_bol 28) + (pos_cnum 43)))))) + (entry + ((src + (In_build_dir default/foo.cma)) + (kind file) + (dst foo.cma) + (section LIB) + (optional false)))) + ((source + (user + ((pos_fname dune) + (start + ((pos_lnum 1) + (pos_bol 0) + (pos_cnum 0))) + (stop + ((pos_lnum 3) + (pos_bol 28) + (pos_cnum 43)))))) + (entry + ((src + (In_build_dir default/.foo.objs/byte/foo.cmi)) + (kind file) + (dst foo.cmi) + (section LIB) + (optional false)))) + ((source + (user + ((pos_fname dune) + (start + ((pos_lnum 1) + (pos_bol 0) + (pos_cnum 0))) + (stop + ((pos_lnum 3) + (pos_bol 28) + (pos_cnum 43)))))) + (entry + ((src + (In_build_dir default/.foo.objs/byte/foo.cmt)) + (kind file) + (dst foo.cmt) + (section LIB) + (optional false)))) + ((source + (user + ((pos_fname dune) + (start + ((pos_lnum 1) + (pos_bol 0) + (pos_cnum 0))) + (stop + ((pos_lnum 3) + (pos_bol 28) + (pos_cnum 43)))))) + (entry + ((src + (In_build_dir default/.foo.objs/native/foo.cmx)) + (kind file) + (dst foo.cmx) + (section LIB) + (optional false)))) + ((source + (user + ((pos_fname dune) + (start + ((pos_lnum 1) + (pos_bol 0) + (pos_cnum 0))) + (stop + ((pos_lnum 3) + (pos_bol 28) + (pos_cnum 43)))))) + (entry + ((src + (In_build_dir default/foo.cmxa)) + (kind file) + (dst foo.cmxa) + (section LIB) + (optional false)))) + ((source + (user + ((pos_fname dune) + (start + ((pos_lnum 1) + (pos_bol 0) + (pos_cnum 0))) + (stop + ((pos_lnum 3) + (pos_bol 28) + (pos_cnum 43)))))) + (entry + ((src + (In_build_dir default/foo.ml)) + (kind file) + (dst foo.ml) + (section LIB) + (optional false)))) + ((source dune) + (entry + ((src + (In_build_dir default/foo.opam)) + (kind file) + (dst opam) + (section LIB) + (optional false)))) + ((source + (user + ((pos_fname dune) + (start + ((pos_lnum 1) + (pos_bol 0) + (pos_cnum 0))) + (stop + ((pos_lnum 3) + (pos_bol 28) + (pos_cnum 43)))))) + (entry + ((src + (In_build_dir default/foo.cmxs)) + (kind file) + (dst foo.cmxs) + (section LIBEXEC) + (optional false)))) + ((source + (user + ((pos_fname dune) + (start + ((pos_lnum 13) + (pos_bol 144) + (pos_cnum 152))) + (stop + ((pos_lnum 13) + (pos_bol 144) + (pos_cnum 160)))))) + (entry + ((src + (In_build_dir default/main.exe)) + (kind file) + (dst main.exe) + (section BIN) + (optional false))))))) From 20b87be6b5b4455646cb52e9c92c45a0796d8d9b Mon Sep 17 00:00:00 2001 From: Alpha Issiaga DIALLO Date: Fri, 7 Jul 2023 11:13:01 +0200 Subject: [PATCH 2/4] Update src/install/entry.ml Co-authored-by: Etienne Millon Signed-off-by: Alpha Issiaga DIALLO --- src/install/entry.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/install/entry.ml b/src/install/entry.ml index 20116d59ca8..b91e9f76045 100644 --- a/src/install/entry.ml +++ b/src/install/entry.ml @@ -130,8 +130,8 @@ module Sourced = struct let to_dyn { source; entry } = let open Dyn in let source_to_dyn = function - | Dune -> String "dune" - | User loc -> Variant ("user", [ Loc.to_dyn loc ]) + | Dune -> Variant ("Dune", []) + | User loc -> Variant ("User", [ Loc.to_dyn loc ]) in Record [ ("source", source_to_dyn source); ("entry", to_dyn entry) ] end From 6ae4006865826852e196486eca76d796dde330fc Mon Sep 17 00:00:00 2001 From: Alpha DIALLO Date: Fri, 7 Jul 2023 12:03:31 +0200 Subject: [PATCH 3/4] Fix tests Signed-off-by: Alpha DIALLO --- bin/describe/package_entries.ml | 1 - .../test-cases/describe-package-entries.t | 26 +++++++++---------- 2 files changed, 13 insertions(+), 14 deletions(-) diff --git a/bin/describe/package_entries.ml b/bin/describe/package_entries.ml index f66a941f2e6..3f4d95939ad 100644 --- a/bin/describe/package_entries.ml +++ b/bin/describe/package_entries.ml @@ -1,5 +1,4 @@ open Import -open Stdune let term = let+ common = Common.term diff --git a/test/blackbox-tests/test-cases/describe-package-entries.t b/test/blackbox-tests/test-cases/describe-package-entries.t index 41600aa8e3f..ab2fff5495a 100644 --- a/test/blackbox-tests/test-cases/describe-package-entries.t +++ b/test/blackbox-tests/test-cases/describe-package-entries.t @@ -1,7 +1,7 @@ Test for the `dune describe package-entries` command $ cat >dune-project < (lang dune 2.7) + > (lang dune 3.10) > (package > (name foo) > (synopsis "describe package-entries")) @@ -30,7 +30,7 @@ Test for the `dune describe package-entries` command $ dune describe package-entries ((foo - (((source dune) + (((source Dune) (entry ((src (In_build_dir default/META.foo)) @@ -38,7 +38,7 @@ Test for the `dune describe package-entries` command (dst META) (section LIB) (optional false)))) - ((source dune) + ((source Dune) (entry ((src (In_build_dir default/foo.dune-package)) @@ -47,7 +47,7 @@ Test for the `dune describe package-entries` command (section LIB) (optional false)))) ((source - (user + (User ((pos_fname dune) (start ((pos_lnum 1) @@ -65,7 +65,7 @@ Test for the `dune describe package-entries` command (section LIB) (optional false)))) ((source - (user + (User ((pos_fname dune) (start ((pos_lnum 1) @@ -83,7 +83,7 @@ Test for the `dune describe package-entries` command (section LIB) (optional false)))) ((source - (user + (User ((pos_fname dune) (start ((pos_lnum 1) @@ -101,7 +101,7 @@ Test for the `dune describe package-entries` command (section LIB) (optional false)))) ((source - (user + (User ((pos_fname dune) (start ((pos_lnum 1) @@ -119,7 +119,7 @@ Test for the `dune describe package-entries` command (section LIB) (optional false)))) ((source - (user + (User ((pos_fname dune) (start ((pos_lnum 1) @@ -137,7 +137,7 @@ Test for the `dune describe package-entries` command (section LIB) (optional false)))) ((source - (user + (User ((pos_fname dune) (start ((pos_lnum 1) @@ -155,7 +155,7 @@ Test for the `dune describe package-entries` command (section LIB) (optional false)))) ((source - (user + (User ((pos_fname dune) (start ((pos_lnum 1) @@ -172,7 +172,7 @@ Test for the `dune describe package-entries` command (dst foo.ml) (section LIB) (optional false)))) - ((source dune) + ((source Dune) (entry ((src (In_build_dir default/foo.opam)) @@ -181,7 +181,7 @@ Test for the `dune describe package-entries` command (section LIB) (optional false)))) ((source - (user + (User ((pos_fname dune) (start ((pos_lnum 1) @@ -199,7 +199,7 @@ Test for the `dune describe package-entries` command (section LIBEXEC) (optional false)))) ((source - (user + (User ((pos_fname dune) (start ((pos_lnum 13) From 15871bdaf4d2e6775c0642528397e77726a4fa17 Mon Sep 17 00:00:00 2001 From: Alpha DIALLO Date: Mon, 24 Jul 2023 11:25:46 +0200 Subject: [PATCH 4/4] Update changelog Signed-off-by: Alpha DIALLO --- CHANGES.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index 218d0a11594..785eb4553fc 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -15,6 +15,9 @@ Unreleased - Fix bug with ppx and Reason syntax due to missing dependency in sandboxed action (#7932, fixes #7930, @Alizter) +- Add `dune describe package-entries` to print all package entries (#7480, + @moyodiallo) + 3.9.1 (2023-07-06) ------------------