Refactor: print in the good format

Signed-off-by: Alpha DIALLO <[email protected]>
ocaml · Apr 17, 2023 · 4e6ee5b · 4e6ee5b
1 parent c1cef66
commit 4e6ee5b
Show file tree

Hide file tree

Showing 4 changed files with 100 additions and 88 deletions.
diff --git a/bin/describe.ml b/bin/describe.ml
@@ -708,7 +708,7 @@ module 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 ->

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,22 @@ module Entry = struct
 
   let map_dst t ~f = { t with dst = f t.dst }
 
+  let to_dyn t =
+    let open Dyn in
+    let kind = function
+      | `File -> "file"
+      | `Directory -> "directory"
+    in
+    let record =
+      record
+        [ ("src", Path.Build.to_dyn t.src)
+        ; ("kind", String (kind t.kind))
+        ; ("dst", Dst.to_dyn t.dst)
+        ; ("section", Section.to_dyn t.section)
+        ]
+    in
+    ("entry", record)
+
   module Sourced = struct
     type source =
       | User of Loc.t
@@ -278,23 +294,11 @@ module Entry = struct
 
     let to_dyn t =
       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 t.source); to_dyn t.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)
@@ -30,69 +29,80 @@ Test for the `dune describe package-entries` command
 
   $ 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 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)))))))