WIP: dune build @doc-json

The `odoc` tool supports a `--as-json` flag. When used in `odoc
html-generate`, it will output `.html.json` files instead of `.html`
files.

These files contain HTML fragments that can be used by external tools to
generate HTML documents using a different pipeline.

This is exposed in Dune by defining a new `@doc-json` alias that works
like `@doc` (it builds the documentation for public packages) but emits
JSON files.

Signed-off-by: Etienne Millon <me@emillon.org>

Author: emillon

src/dune_engine/alias.ml

@@ -107,6 +107,9 @@ let install = make_standard Name.install
 
 let doc = make_standard (Name.of_string "doc")
 
+(** XXX is there anything to do to make a new standard alias? document it? *)
+let doc_json = make_standard (Name.of_string "doc-json")
+
 let private_doc = make_standard (Name.of_string "doc-private")
 
 let lint = make_standard (Name.of_string "lint")

src/dune_engine/alias.mli

@@ -52,6 +52,8 @@ val install : dir:Path.Build.t -> t
 
 val doc : dir:Path.Build.t -> t
 
+val doc_json : dir:Path.Build.t -> t
+
 val private_doc : dir:Path.Build.t -> t
 
 val lint : dir:Path.Build.t -> t

src/dune_rules/odoc.ml

@@ -72,6 +72,7 @@ type odoc_artefact =
   { odoc_file : Path.Build.t
   ; odocl_file : Path.Build.t
   ; html_file : Path.Build.t
+  ; json_file : Path.Build.t
   }
 
 let add_rule sctx =
@@ -112,11 +113,40 @@ module Paths = struct
   let toplevel_index ctx = html_root ctx ++ "index.html"
 end
 
+module Format = struct
+  type t =
+    | Html
+    | Json
+
+  let all = [ Html; Json ]
+
+  let extension = function
+    | Html -> ".html"
+    | Json -> ".html.json"
+
+  let args = function
+    | Html -> Command.Args.empty
+    | Json -> A "--as-json"
+
+  let target format odoc_file =
+    match format with
+    | Html -> odoc_file.html_file
+    | Json -> odoc_file.json_file
+
+  let alias format ~dir =
+    match format with
+    | Html -> Alias.doc ~dir
+    | Json -> Alias.doc_json ~dir
+end
+
 module Dep : sig
   (** [html_alias ctx target] returns the alias that depends on all html targets
       produced by odoc for [target] *)
   val html_alias : Context.t -> target -> Alias.t
 
+  (** XXX doc *)
+  val format_alias : Format.t -> Context.t -> target -> Alias.t
+
   (** [deps ctx pkg libraries] returns all odoc dependencies of [libraries]. If
       [libraries] are all part of a package [pkg], then the odoc dependencies of
       the package are also returned*)
@@ -130,7 +160,9 @@ module Dep : sig
     These dependencies may be used using the [deps] function *)
   val setup_deps : Context.t -> target -> Path.Set.t -> unit Memo.t
 end = struct
-  let html_alias ctx m = Alias.doc ~dir:(Paths.html ctx m)
+  let format_alias f ctx m = Format.alias f ~dir:(Paths.html ctx m)
+
+  let html_alias = format_alias Html
 
   let alias = Alias.make (Alias.Name.of_string ".odoc-all")
 
@@ -335,7 +367,7 @@ let setup_library_odoc_rules cctx (local_lib : Lib.Local.t) =
   Dep.setup_deps ctx (Lib local_lib)
     (Path.Set.of_list_map modules_and_odoc_files ~f:(fun (_, p) -> Path.build p))
 
-let setup_html sctx (odoc_file : odoc_artefact) =
+let setup_generate sctx (odoc_file : odoc_artefact) format =
   let ctx = Super_context.context sctx in
   let open Memo.O in
   let odoc_support_path = Paths.odoc_support ctx in
@@ -350,11 +382,15 @@ let setup_html sctx (odoc_file : odoc_artefact) =
       ; A "--theme-uri"
       ; Path (Path.build odoc_support_path)
       ; Dep (Path.build odoc_file.odocl_file)
-      ; Hidden_targets [ odoc_file.html_file ]
+      ; Format.args format
+      ; Hidden_targets [ Format.target format odoc_file ]
       ]
   in
   add_rule sctx run_odoc
 
+let setup_generate_all sctx odoc_file =
+  Memo.parallel_iter Format.all ~f:(setup_generate sctx odoc_file)
+
 let setup_css_rule sctx =
   let open Memo.O in
   let ctx = Super_context.context sctx in
@@ -453,15 +489,18 @@ let create_odoc ctx ~target odoc_file =
   match target with
   | Lib _ ->
     let html_dir = html_base ++ Stdune.String.capitalize basename in
-    { odoc_file; odocl_file; html_file = html_dir ++ "index.html" }
+    let file format =
+      html_dir ++ "index"
+      |> Path.Build.extend_basename ~suffix:(Format.extension format)
+    in
+    { odoc_file; odocl_file; html_file = file Html; json_file = file Json }
   | Pkg _ ->
-    { odoc_file
-    ; odocl_file
-    ; html_file =
-        html_base
-        ++ sprintf "%s.html"
-             (basename |> String.drop_prefix ~prefix:"page-" |> Option.value_exn)
-    }
+    let file format =
+      html_base
+      ++ (basename |> String.drop_prefix ~prefix:"page-" |> Option.value_exn)
+      |> Path.Build.extend_basename ~suffix:(Format.extension format)
+    in
+    { odoc_file; odocl_file; html_file = file Html; json_file = file Json }
 
 let static_html ctx =
   let open Paths in
@@ -580,6 +619,20 @@ let setup_pkg_odocl_rules_def =
 let setup_pkg_odocl_rules sctx ~pkg : unit Memo.t =
   Memo.With_implicit_output.exec setup_pkg_odocl_rules_def (sctx, pkg)
 
+let out_file (format : Format.t) odoc =
+  match format with
+  | Html -> odoc.html_file
+  | Json -> odoc.json_file
+
+let out_files ctx (format : Format.t) odocs =
+  let extra_files =
+    match format with
+    | Html -> List.map ~f:Path.build (static_html ctx)
+    | Json -> []
+  in
+  List.rev_append extra_files
+    (List.map odocs ~f:(fun odoc -> Path.build (out_file format odoc)))
+
 let setup_lib_html_rules_def =
   let module Input = struct
     module Super_context = Super_context.As_memo_key
@@ -596,12 +649,14 @@ let setup_lib_html_rules_def =
   let f (sctx, lib) =
     let ctx = Super_context.context sctx in
     let* odocs = odoc_artefacts sctx (Lib lib) in
-    let* () = Memo.parallel_iter odocs ~f:(fun odoc -> setup_html sctx odoc) in
-    let html_files = List.map ~f:(fun o -> Path.build o.html_file) odocs in
-    let static_html = List.map ~f:Path.build (static_html ctx) in
-    Rules.Produce.Alias.add_deps
-      (Dep.html_alias ctx (Lib lib))
-      (Action_builder.paths (List.rev_append static_html html_files))
+    let* () =
+      Memo.parallel_iter odocs ~f:(fun odoc -> setup_generate_all sctx odoc)
+    in
+    Memo.parallel_iter Format.all ~f:(fun format ->
+        let paths = out_files ctx format odocs in
+        Rules.Produce.Alias.add_deps
+          (Dep.format_alias format ctx (Lib lib))
+          (Action_builder.paths paths))
   in
   Memo.With_implicit_output.create "setup-library-html-rules"
     ~implicit_output:Rules.implicit_output
@@ -618,40 +673,41 @@ let setup_pkg_html_rules_def =
     let* () = Memo.parallel_iter libs ~f:(setup_lib_html_rules sctx)
     and* pkg_odocs =
       let* pkg_odocs = odoc_artefacts sctx (Pkg pkg) in
-      let+ () = Memo.parallel_iter pkg_odocs ~f:(fun o -> setup_html sctx o) in
+      let+ () = Memo.parallel_iter pkg_odocs ~f:(setup_generate_all sctx) in
       pkg_odocs
     and* lib_odocs =
       Memo.parallel_map libs ~f:(fun lib -> odoc_artefacts sctx (Lib lib))
     in
     let odocs = List.concat (pkg_odocs :: lib_odocs) in
-    let html_files = List.map ~f:(fun o -> Path.build o.html_file) odocs in
-    let static_html = List.map ~f:Path.build (static_html ctx) in
-    Rules.Produce.Alias.add_deps
-      (Dep.html_alias ctx (Pkg pkg))
-      (Action_builder.paths (List.rev_append static_html html_files))
+    Memo.parallel_iter Format.all ~f:(fun format ->
+        let paths = out_files ctx format odocs in
+        Rules.Produce.Alias.add_deps
+          (Dep.format_alias format ctx (Pkg pkg))
+          (Action_builder.paths paths))
   in
   setup_pkg_rules_def "setup-package-html-rules" f
 
 let setup_pkg_html_rules sctx ~pkg : unit Memo.t =
   Memo.With_implicit_output.exec setup_pkg_html_rules_def (sctx, pkg)
 
-let setup_package_aliases sctx (pkg : Package.t) =
+let setup_package_aliases_format sctx (pkg : Package.t) (format : Format.t) =
   let ctx = Super_context.context sctx in
   let name = Package.name pkg in
   let alias =
     let pkg_dir = Package.dir pkg in
     let dir = Path.Build.append_source ctx.build_dir pkg_dir in
-    Alias.doc ~dir
-  in
-  let* libs =
-    libs_of_pkg ctx ~pkg:name
-    >>| List.map ~f:(fun lib -> Dep.html_alias ctx (Lib lib))
+    Format.alias format ~dir
   in
-  Dep.html_alias ctx (Pkg name) :: libs
+  let* libs = libs_of_pkg ctx ~pkg:name >>| List.map ~f:(fun lib -> Lib lib) in
+  Pkg name :: libs
+  |> List.map ~f:(Dep.format_alias format ctx)
   |> Dune_engine.Dep.Set.of_list_map ~f:(fun f -> Dune_engine.Dep.alias f)
   |> Action_builder.deps
   |> Rules.Produce.Alias.add_deps alias
 
+let setup_package_aliases sctx (pkg : Package.t) =
+  Memo.parallel_iter Format.all ~f:(setup_package_aliases_format sctx pkg)
+
 let default_index ~pkg entry_modules =
   let b = Buffer.create 512 in
   Printf.bprintf b "{0 %s index}\n" (Package.Name.to_string pkg);

test/blackbox-tests/test-cases/odoc/doc-json.t

@@ -0,0 +1,24 @@
+  $ cat > dune-project << EOF
+  > (lang dune 3.10)
+  > 
+  > (package
+  >  (name l))
+  > EOF
+
+  $ cat > dune << EOF
+  > (library
+  >  (public_name l))
+  > EOF
+
+  $ cat > l.ml << EOF
+  > module M = struct
+  >   type t = int
+  > end
+  > EOF
+
+  $ dune build @doc-json
+
+  $ find _build/default/_doc/_html/ -name '*.html' -o -name '*.html.json'
+  _build/default/_doc/_html/l/index.html.json
+  _build/default/_doc/_html/l/L/M/index.html.json
+  _build/default/_doc/_html/l/L/index.html.json