Driver: status.json: add pkg name, version and list of files

jonludlam · Feb 12, 2025 · 224e782 · 224e782
1 parent dd165ac
commit 224e782
Show file tree

Hide file tree

Showing 2 changed files with 45 additions and 18 deletions.
diff --git a/src/driver/bin/odoc_driver_voodoo.ml b/src/driver/bin/odoc_driver_voodoo.ml
@@ -38,24 +38,7 @@ let generate_status ~html_dir pkg =
       pkg.Packages.libraries;
     redirections
   in
-  let status =
-    let failed = `Bool false in
-    let files = `List [] in
-    let redirections =
-      Hashtbl.fold
-        (fun old_path new_path acc ->
-          `Assoc
-            [
-              ("old_path", `String (Fpath.to_string old_path));
-              ("new_path", `String (Fpath.to_string new_path));
-            ]
-          :: acc)
-        redirections []
-    in
-    let redirections = `List redirections in
-    `Assoc
-      [ ("files", files); ("failed", failed); ("redirections", redirections) ]
-  in
+  let status = Status.json ~html_dir ~pkg ~redirections () in
   let status = Yojson.Safe.pretty_to_string status in
   let status_path = Fpath.(html_dir // Odoc_unit.pkg_dir pkg / "status.json") in
   match Bos.OS.File.write status_path status with

diff --git a/src/driver/status.ml b/src/driver/status.ml
@@ -0,0 +1,44 @@
+let json ~html_dir ~pkg ?(redirections = Hashtbl.create 0) () =
+  let files =
+    let lib_dir = Odoc_unit.pkg_dir pkg in
+    let lib_dir = Fpath.( // ) html_dir lib_dir in
+    let files =
+      Bos.OS.Dir.fold_contents
+        ~elements:(`Sat (fun x -> Ok (Fpath.has_ext "html" x)))
+        (fun path acc ->
+          `String
+            (Fpath.to_string (Fpath.rem_prefix lib_dir path |> Option.get))
+          :: acc)
+        [] lib_dir
+      |> function
+      | Ok e -> e
+      | Error (`Msg err) ->
+          Logs.err (fun m ->
+              m "Got an error while collecting files for status.json: %s" err);
+          []
+    in
+    `List files
+  in
+  let name = `String pkg.Packages.name in
+  let version = `String pkg.Packages.version in
+  let failed = `Bool false in
+  let redirections =
+    Hashtbl.fold
+      (fun old_path new_path acc ->
+        `Assoc
+          [
+            ("old_path", `String (Fpath.to_string old_path));
+            ("new_path", `String (Fpath.to_string new_path));
+          ]
+        :: acc)
+      redirections []
+  in
+  let redirections = `List redirections in
+  `Assoc
+    [
+      ("name", name);
+      ("version", version);
+      ("files", files);
+      ("failed", failed);
+      ("redirections", redirections);
+    ]