Add "dune describe package-entries" (ocaml#7480)

* 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 <[email protected]> Co-authored-by: Etienne Millon <[email protected]>
pmwhite · Aug 10, 2023 · 9910cbb · 9910cbb
1 parent 2e3b5f4
commit 9910cbb
Show file tree

Hide file tree

Showing 10 changed files with 281 additions and 0 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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.<package-name>] files. and
     [<package-name>.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
@@ -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
@@ -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
@@ -0,0 +1,218 @@
+Test for the `dune describe package-entries` command
+
+  $ cat >dune-project <<EOF
+  > (lang dune 3.10)
+  > (package
+  >  (name foo)
+  >  (synopsis "describe package-entries"))
+  > (generate_opam_files)
+  > EOF
+
+  $ cat >dune <<EOF
+  > (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)))))))