Refactor: print in the good format

Signed-off-by: Alpha DIALLO <moyodiallo@gmail.com>
ocaml · Apr 20, 2023 · 833cfb6 · 833cfb6
1 parent c1cef66
commit 833cfb6
Show file tree

Hide file tree

Showing 4 changed files with 110 additions and 93 deletions.
diff --git a/bin/describe.ml b/bin/describe.ml
@@ -704,11 +704,11 @@ module External_lib_deps = struct
     external_resolved_libs setup super_context >>| to_dyn context_name
 end
 
-module Entries = struct
+module Pacakge_entries = struct
   let get super_context =
     let open Memo.O in
     let+ package_entries =
-      Dune_rules.Entries.stanzas_to_entries super_context
+      Dune_rules.Install_rules.stanzas_to_entries super_context
     in
     Package.Name.Map.to_dyn
       (fun entries ->
@@ -802,7 +802,7 @@ module What = struct
     | Workspace of { dirs : string list option }
     | External_lib_deps
     | Opam_files
-    | Entries
+    | Package_entries
     | Pp of string
 
   (** By default, describe the whole workspace *)
@@ -833,7 +833,7 @@ module What = struct
     ; ( "package-entries"
       , []
       , "prints information about the entries per package"
-      , return Entries )
+      , return Package_entries )
     ; ( "pp"
       , [ "FILE" ]
       , "builds a given FILE and prints the preprocessed output"
@@ -881,7 +881,7 @@ module What = struct
     let some = Memo.map ~f:(fun x -> Some x) in
     match t with
     | Opam_files -> Opam_files.get () |> some
-    | Entries -> Entries.get super_context |> some
+    | Package_entries -> Pacakge_entries.get super_context |> some
     | External_lib_deps -> External_lib_deps.get setup super_context |> some
     | Workspace { dirs } ->
       let context = Super_context.context super_context in

diff --git a/src/dune_rules/dune_rules.ml b/src/dune_rules/dune_rules.ml
@@ -54,12 +54,10 @@ module Lib_name = Lib_name
 module Diff = Dune_lang.Action.Diff
 module Clflags = Clflags
 
-module Entries = struct
-  let stanzas_to_entries = Install_rules.stanzas_to_entries
-end
-
 module Install_rules = struct
   let install_file = Install_rules.install_file
+
+  let stanzas_to_entries = Install_rules.stanzas_to_entries
 end
 
 (* Only for tests *)

diff --git a/src/dune_rules/install.ml b/src/dune_rules/install.ml
@@ -258,6 +258,19 @@ module Entry = struct
 
   let map_dst t ~f = { t with dst = f t.dst }
 
+  let to_dyn { src; kind; dst; section } =
+    let open Dyn in
+    let kind_to_dyn = function
+      | `File -> String "file"
+      | `Directory -> String "directory"
+    in
+    record
+      [ ("src", Path.Build.to_dyn src)
+      ; ("kind", kind_to_dyn kind)
+      ; ("dst", Dst.to_dyn dst)
+      ; ("section", Section.to_dyn section)
+      ]
+
   module Sourced = struct
     type source =
       | User of Loc.t
@@ -276,25 +289,13 @@ module Entry = struct
       ; entry
       }
 
-    let to_dyn t =
+    let to_dyn { source; entry } =
       let open Dyn in
-      let source = function
-        | Dune -> "dune"
-        | User _ -> "user"
-      in
-      let kind = function
-        | `File -> "file"
-        | `Directory -> "directory"
-      in
-      let record =
-        record
-          [ ("src", Path.Build.to_dyn t.entry.src)
-          ; ("kind", String (kind t.entry.kind))
-          ; ("dst", Dst.to_dyn t.entry.dst)
-          ; ("section", Section.to_dyn t.entry.section)
-          ]
+      let source_to_dyn = function
+        | Dune -> String "dune"
+        | User _ -> String "user"
       in
-      Variant (source t.source, [ record ])
+      Record [ ("source", source_to_dyn source); ("entry", to_dyn entry) ]
   end
 
   let compare compare_src { src; dst; section; kind } t =

diff --git a/test/blackbox-tests/test-cases/describe-package-entries.t b/test/blackbox-tests/test-cases/describe-package-entries.t
@@ -1,5 +1,4 @@
 Test for the `dune describe package-entries` command
-====================================
 
   $ cat >dune-project <<EOF
   > (lang dune 2.7)
@@ -27,72 +26,91 @@ Test for the `dune describe package-entries` command
 
   $ touch main.ml
   $ touch foo.ml
+  $ touch foo.opam
 
   $ dune describe package-entries
   ((foo
-    ((dune
-      ((src
-        (In_build_dir default/META.foo))
-       (kind file)
-       (dst META)
-       (section LIB)))
-     (dune
-      ((src
-        (In_build_dir default/foo.dune-package))
-       (kind file)
-       (dst dune-package)
-       (section LIB)))
-     (user
-      ((src
-        (In_build_dir default/foo.a))
-       (kind file)
-       (dst foo.a)
-       (section LIB)))
-     (user
-      ((src
-        (In_build_dir default/foo.cma))
-       (kind file)
-       (dst foo.cma)
-       (section LIB)))
-     (user
-      ((src
-        (In_build_dir default/.foo.objs/byte/foo.cmi))
-       (kind file)
-       (dst foo.cmi)
-       (section LIB)))
-     (user
-      ((src
-        (In_build_dir default/.foo.objs/byte/foo.cmt))
-       (kind file)
-       (dst foo.cmt)
-       (section LIB)))
-     (user
-      ((src
-        (In_build_dir default/.foo.objs/native/foo.cmx))
-       (kind file)
-       (dst foo.cmx)
-       (section LIB)))
-     (user
-      ((src
-        (In_build_dir default/foo.cmxa))
-       (kind file)
-       (dst foo.cmxa)
-       (section LIB)))
-     (user
-      ((src
-        (In_build_dir default/foo.ml))
-       (kind file)
-       (dst foo.ml)
-       (section LIB)))
-     (user
-      ((src
-        (In_build_dir default/foo.cmxs))
-       (kind file)
-       (dst foo.cmxs)
-       (section LIBEXEC)))
-     (user
-      ((src
-        (In_build_dir default/main.exe))
-       (kind file)
-       (dst main.exe)
-       (section BIN))))))
+    (((source dune)
+      (entry
+       ((src
+         (In_build_dir default/META.foo))
+        (kind file)
+        (dst META)
+        (section LIB))))
+     ((source dune)
+      (entry
+       ((src
+         (In_build_dir default/foo.dune-package))
+        (kind file)
+        (dst dune-package)
+        (section LIB))))
+     ((source user)
+      (entry
+       ((src
+         (In_build_dir default/foo.a))
+        (kind file)
+        (dst foo.a)
+        (section LIB))))
+     ((source user)
+      (entry
+       ((src
+         (In_build_dir default/foo.cma))
+        (kind file)
+        (dst foo.cma)
+        (section LIB))))
+     ((source user)
+      (entry
+       ((src
+         (In_build_dir default/.foo.objs/byte/foo.cmi))
+        (kind file)
+        (dst foo.cmi)
+        (section LIB))))
+     ((source user)
+      (entry
+       ((src
+         (In_build_dir default/.foo.objs/byte/foo.cmt))
+        (kind file)
+        (dst foo.cmt)
+        (section LIB))))
+     ((source user)
+      (entry
+       ((src
+         (In_build_dir default/.foo.objs/native/foo.cmx))
+        (kind file)
+        (dst foo.cmx)
+        (section LIB))))
+     ((source user)
+      (entry
+       ((src
+         (In_build_dir default/foo.cmxa))
+        (kind file)
+        (dst foo.cmxa)
+        (section LIB))))
+     ((source user)
+      (entry
+       ((src
+         (In_build_dir default/foo.ml))
+        (kind file)
+        (dst foo.ml)
+        (section LIB))))
+     ((source dune)
+      (entry
+       ((src
+         (In_build_dir default/foo.opam))
+        (kind file)
+        (dst opam)
+        (section LIB))))
+     ((source user)
+      (entry
+       ((src
+         (In_build_dir default/foo.cmxs))
+        (kind file)
+        (dst foo.cmxs)
+        (section LIBEXEC))))
+     ((source user)
+      (entry
+       ((src
+         (In_build_dir default/main.exe))
+        (kind file)
+        (dst main.exe)
+        (section BIN)))))))