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>

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

@@ -77,6 +77,7 @@ type odoc_artefact =
   ; odocl_file : Path.Build.t
   ; html_dir : Path.Build.t
   ; html_file : Path.Build.t
+  ; json_file : Path.Build.t
   ; source : source  (** source of the [odoc_file], either module or mld *)
   }
 
@@ -118,11 +119,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*)
@@ -136,7 +166,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")
 
@@ -341,17 +373,17 @@ 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 dummy =
-    match odoc_file.source with
-    | Mld -> []
-    | Module ->
+    match (odoc_file.source, format) with
+    | Module, Format.Html ->
       (* Dummy target so that the below rule as at least one target. We do this
          because we don't know the targets of odoc in this case. The proper way
          to support this would be to have directory targets. *)
       let dummy = Action_builder.create_file (odoc_file.html_dir ++ ".dummy") in
       [ dummy ]
+    | _ -> []
   in
   let open Memo.O in
   let odoc_support_path = Paths.odoc_support ctx in
@@ -366,11 +398,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 (Action_builder.progn (run_odoc :: dummy))
 
+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
@@ -469,20 +505,28 @@ let create_odoc ctx ~target odoc_file =
   match target with
   | Lib _ ->
     let html_dir = html_base ++ Stdune.String.capitalize basename in
+    let file format =
+      html_dir ++ "index"
+      |> Path.Build.extend_basename ~suffix:(Format.extension format)
+    in
     { odoc_file
     ; odocl_file
     ; html_dir
-    ; html_file = html_dir ++ "index.html"
+    ; html_file = file Html
+    ; json_file = file Json
     ; source = Module
     }
   | Pkg _ ->
+    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_dir = html_base
-    ; html_file =
-        html_base
-        ++ sprintf "%s.html"
-             (basename |> String.drop_prefix ~prefix:"page-" |> Option.value_exn)
+    ; html_file = file Html
+    ; json_file = file Json
     ; source = Mld
     }
 
@@ -603,6 +647,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
@@ -619,12 +677,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
@@ -641,40 +701,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