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) ------------------ 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..3f4d95939ad --- /dev/null +++ b/bin/describe/package_entries.ml @@ -0,0 +1,23 @@ +open Import + +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..b91e9f76045 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 -> Variant ("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..ab2fff5495a --- /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 3.10) + > (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)))))))