From b2f1c58240be6c6222312c7255a6cb812079a6f4 Mon Sep 17 00:00:00 2001 From: Etienne Millon Date: Thu, 7 Sep 2023 14:57:22 +0200 Subject: [PATCH 1/4] feature: 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 --- doc/changes/odoc-json.md | 2 + doc/reference/aliases.rst | 9 +- src/dune_rules/alias0.ml | 1 + src/dune_rules/alias0.mli | 1 + src/dune_rules/odoc.ml | 126 +++++++++++++----- .../blackbox-tests/test-cases/odoc/doc-json.t | 39 ++++++ 6 files changed, 145 insertions(+), 33 deletions(-) create mode 100644 doc/changes/odoc-json.md create mode 100644 test/blackbox-tests/test-cases/odoc/doc-json.t diff --git a/doc/changes/odoc-json.md b/doc/changes/odoc-json.md new file mode 100644 index 00000000000..e45ace4827f --- /dev/null +++ b/doc/changes/odoc-json.md @@ -0,0 +1,2 @@ +- Add a new alias `@doc-json` to build odoc documentation in JSON format. This + output can be consumed by external tools. (#8178, @emillon) diff --git a/doc/reference/aliases.rst b/doc/reference/aliases.rst index 8f6bdbccacd..593391caf51 100644 --- a/doc/reference/aliases.rst +++ b/doc/reference/aliases.rst @@ -105,7 +105,14 @@ used instead. For example, if the following is present in ``tests/dune``, @doc ^^^^ -This alias builds documentation for public libraries. +This alias builds documentation for public libraries as HTML pages. + +@doc-json +^^^^^^^^^ + +This alias builds documentation for public libraries as JSON files. These are +produced by ``odoc``'s option ``--as-json`` and can be consumed by external +tools. @doc-private ^^^^^^^^^^^^ diff --git a/src/dune_rules/alias0.ml b/src/dune_rules/alias0.ml index 410eac39dce..5aca23292c1 100644 --- a/src/dune_rules/alias0.ml +++ b/src/dune_rules/alias0.ml @@ -10,6 +10,7 @@ let fmt = standard "fmt" let lint = standard "lint" let private_doc = standard "doc-private" let doc = standard "doc" +let doc_json = standard "doc-json" let check = standard "check" let install = standard "install" let runtest = standard "runtest" diff --git a/src/dune_rules/alias0.mli b/src/dune_rules/alias0.mli index 6185610ae2d..2a82d7bb8f3 100644 --- a/src/dune_rules/alias0.mli +++ b/src/dune_rules/alias0.mli @@ -6,6 +6,7 @@ module Name := Dune_engine.Alias.Name val fmt : Name.t val doc : Name.t +val doc_json : Name.t val lint : Name.t val private_doc : Name.t val check : Name.t diff --git a/src/dune_rules/odoc.ml b/src/dune_rules/odoc.ml index 0bad2975a48..1898b27e941 100644 --- a/src/dune_rules/odoc.ml +++ b/src/dune_rules/odoc.ml @@ -75,6 +75,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 = @@ -111,9 +112,43 @@ module Paths = struct let toplevel_index ctx = html_root ctx ++ "index.html" end +module Output_format = struct + type t = + | Html + | Json + + let all = [ Html; Json ] + let iter ~f = Memo.parallel_iter all ~f + + let extension = function + | Html -> ".html" + | Json -> ".html.json" + ;; + + let args = function + | Html -> Command.Args.empty + | Json -> A "--as-json" + ;; + + let target t odoc_file = + match t with + | Html -> odoc_file.html_file + | Json -> odoc_file.json_file + ;; + + let alias t ~dir = + match t with + | Html -> Alias.make Alias0.doc ~dir + | Json -> Alias.make Alias0.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] *) + (** [format_alias output ctx target] returns the alias that depends on all + targets produced by odoc for [target] in output format [output]. *) + val format_alias : Output_format.t -> Context.t -> target -> Alias.t + + (** [html_alias] is [format_alias Html] *) val html_alias : Context.t -> target -> Alias.t (** [deps ctx pkg libraries] returns all odoc dependencies of [libraries]. If @@ -129,7 +164,8 @@ 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.make Alias0.doc ~dir:(Paths.html ctx m) + let format_alias f ctx m = Output_format.alias f ~dir:(Paths.html ctx m) + let html_alias = format_alias Html let alias = Alias.make (Alias.Name.of_string ".odoc-all") let deps ctx pkg requires = @@ -368,7 +404,7 @@ let setup_library_odoc_rules cctx (local_lib : Lib.Local.t) = (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) out = let ctx = Super_context.context sctx in let open Memo.O in let odoc_support_path = Paths.odoc_support ctx in @@ -385,12 +421,17 @@ 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 ] + ; Output_format.args out + ; Hidden_targets [ Output_format.target out odoc_file ] ] in add_rule sctx run_odoc ;; +let setup_generate_all sctx odoc_file = + Output_format.iter ~f:(setup_generate sctx odoc_file) +;; + let setup_css_rule sctx = let open Memo.O in let ctx = Super_context.context sctx in @@ -498,16 +539,17 @@ 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 output = + html_dir ++ "index" + |> Path.Build.extend_basename ~suffix:(Output_format.extension output) + 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 output = + html_base ++ (basename |> String.drop_prefix ~prefix:"page-" |> Option.value_exn) + |> Path.Build.extend_basename ~suffix:(Output_format.extension output) + in + { odoc_file; odocl_file; html_file = file Html; json_file = file Json } ;; let static_html ctx = @@ -635,6 +677,23 @@ 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 (output : Output_format.t) odoc = + match output with + | Html -> odoc.html_file + | Json -> odoc.json_file +;; + +let out_files ctx (output : Output_format.t) odocs = + let extra_files = + match output 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 output odoc))) +;; + let setup_lib_html_rules_def = let module Input = struct module Super_context = Super_context.As_memo_key @@ -649,12 +708,12 @@ 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 + Output_format.iter ~f:(fun output -> + let paths = out_files ctx output odocs in + Rules.Produce.Alias.add_deps + (Dep.format_alias output ctx (Lib lib)) + (Action_builder.paths paths)) in Memo.With_implicit_output.create "setup-library-html-rules" @@ -674,17 +733,17 @@ 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)) + Output_format.iter ~f:(fun output -> + let paths = out_files ctx output odocs in + Rules.Produce.Alias.add_deps + (Dep.format_alias output ctx (Pkg pkg)) + (Action_builder.paths paths)) in setup_pkg_rules_def "setup-package-html-rules" f ;; @@ -693,23 +752,26 @@ 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) (output : Output_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 (Context.build_dir ctx) pkg_dir in - Alias.make Alias0.doc ~dir - in - let* libs = - libs_of_pkg ctx ~pkg:name >>| List.map ~f:(fun lib -> Dep.html_alias ctx (Lib lib)) + Output_format.alias output ~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 output 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) = + Output_format.iter ~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); diff --git a/test/blackbox-tests/test-cases/odoc/doc-json.t b/test/blackbox-tests/test-cases/odoc/doc-json.t new file mode 100644 index 00000000000..9323a1a45e7 --- /dev/null +++ b/test/blackbox-tests/test-cases/odoc/doc-json.t @@ -0,0 +1,39 @@ + $ 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 + + $ list_docs () { + > find _build/default/_doc/_html -name '*.html' -o -name '*.html.json' | sort + > } + + $ dune build @doc-json + $ list_docs + _build/default/_doc/_html/l/L/M/index.html.json + _build/default/_doc/_html/l/L/index.html.json + _build/default/_doc/_html/l/index.html.json + +@doc will continue generating doc as usual: + + $ dune build @doc + $ list_docs + _build/default/_doc/_html/index.html + _build/default/_doc/_html/l/L/M/index.html + _build/default/_doc/_html/l/L/M/index.html.json + _build/default/_doc/_html/l/L/index.html + _build/default/_doc/_html/l/L/index.html.json + _build/default/_doc/_html/l/index.html + _build/default/_doc/_html/l/index.html.json From 98a02fac489c9a5601edd2369f237be2cf9671a4 Mon Sep 17 00:00:00 2001 From: Etienne Millon Date: Mon, 31 Jul 2023 16:47:22 +0200 Subject: [PATCH 2/4] Add Toplevel_index Signed-off-by: Etienne Millon --- src/dune_rules/odoc.ml | 40 ++++++++++++++++++++++++++++------------ 1 file changed, 28 insertions(+), 12 deletions(-) diff --git a/src/dune_rules/odoc.ml b/src/dune_rules/odoc.ml index 1898b27e941..1c79ee8a70b 100644 --- a/src/dune_rules/odoc.ml +++ b/src/dune_rules/odoc.ml @@ -452,22 +452,32 @@ let setup_css_rule sctx = let sp = Printf.sprintf -let setup_toplevel_index_rule sctx = - let* list_items = - let+ packages = Only_packages.get () in - Package.Name.Map.to_list packages - |> List.filter_map ~f:(fun (name, pkg) -> +module Toplevel_index = struct + type item = + { name : string + ; version : string option + ; link : string + } + + let of_packages packages = + Package.Name.Map.to_list_map packages ~f:(fun name { Package.version; _ } -> let name = Package.Name.to_string name in - let link = sp {|%s|} name name in + { name; version; link = sp "%s/index.html" name }) + ;; + + let html_list_items t = + List.map t ~f:(fun { name; version; link } -> + let link = sp {|%s|} link name in let version_suffix = - match pkg.Package.version with + match version with | None -> "" | Some v -> sp {| %s|} v in - Some (sp "
  • %s%s
    • " link version_suffix)) + sp "
  • %s%s
    • " link version_suffix) |> String.concat ~sep:"\n " - in - let html = + ;; + + let html t = sp {| @@ -489,8 +499,14 @@ let setup_toplevel_index_rule sctx = |} Paths.odoc_support_dirname - list_items - in + (html_list_items t) + ;; +end + +let setup_toplevel_index_rule sctx = + let* packages = Only_packages.get () in + let index = Toplevel_index.of_packages packages in + let html = Toplevel_index.html index in let ctx = Super_context.context sctx in add_rule sctx (Action_builder.write_file (Paths.toplevel_index ctx) html) ;; From 8cc9ca5209c488fa991cad54f8ce9e1e9a241a3b Mon Sep 17 00:00:00 2001 From: Etienne Millon Date: Mon, 31 Jul 2023 17:39:30 +0200 Subject: [PATCH 3/4] Add JSON toplevel index Signed-off-by: Etienne Millon --- otherlibs/chrome-trace/src/chrome_trace.ml | 1 + otherlibs/chrome-trace/src/chrome_trace.mli | 1 + src/dune_rules/odoc.ml | 61 +++++++++++++++---- src/dune_stats/dune_stats.ml | 1 + .../blackbox-tests/test-cases/odoc/doc-json.t | 7 +++ 5 files changed, 58 insertions(+), 13 deletions(-) diff --git a/otherlibs/chrome-trace/src/chrome_trace.ml b/otherlibs/chrome-trace/src/chrome_trace.ml index 94858a66665..128dc496ef9 100644 --- a/otherlibs/chrome-trace/src/chrome_trace.ml +++ b/otherlibs/chrome-trace/src/chrome_trace.ml @@ -9,6 +9,7 @@ module Json = struct | `List of t list | `Bool of bool | `Assoc of (string * t) list + | `Null ] end diff --git a/otherlibs/chrome-trace/src/chrome_trace.mli b/otherlibs/chrome-trace/src/chrome_trace.mli index 94b14256b0c..64c1947fbe3 100644 --- a/otherlibs/chrome-trace/src/chrome_trace.mli +++ b/otherlibs/chrome-trace/src/chrome_trace.mli @@ -19,6 +19,7 @@ module Json : sig | `List of t list | `Bool of bool | `Assoc of (string * t) list + | `Null ] end diff --git a/src/dune_rules/odoc.ml b/src/dune_rules/odoc.ml index 1c79ee8a70b..ac9a1233758 100644 --- a/src/dune_rules/odoc.ml +++ b/src/dune_rules/odoc.ml @@ -141,6 +141,13 @@ module Output_format = struct | Html -> Alias.make Alias0.doc ~dir | Json -> Alias.make Alias0.doc_json ~dir ;; + + let toplevel_index_path format ctx = + let base = Paths.toplevel_index ctx in + match format with + | Html -> base + | Json -> Path.Build.extend_basename base ~suffix:".json" + ;; end module Dep : sig @@ -501,14 +508,46 @@ module Toplevel_index = struct Paths.odoc_support_dirname (html_list_items t) ;; + + let string_to_json s = `String s + let list_to_json ~f l = `List (List.map ~f l) + + let option_to_json ~f = function + | None -> `Null + | Some x -> f x + ;; + + let item_to_json { name; version; link } = + `Assoc + [ "name", string_to_json name + ; "version", option_to_json ~f:string_to_json version + ; "link", string_to_json link + ] + ;; + + (** This format is public API. *) + let to_json items = `Assoc [ "packages", list_to_json items ~f:item_to_json ] + + let json t = Dune_stats.Json.to_string (to_json t) + + let content (output : Output_format.t) t = + match output with + | Html -> html t + | Json -> json t + ;; end -let setup_toplevel_index_rule sctx = +let setup_toplevel_index_rule sctx output = let* packages = Only_packages.get () in let index = Toplevel_index.of_packages packages in - let html = Toplevel_index.html index in + let content = Toplevel_index.content output index in let ctx = Super_context.context sctx in - add_rule sctx (Action_builder.write_file (Paths.toplevel_index ctx) html) + let path = Output_format.toplevel_index_path output ctx in + add_rule sctx (Action_builder.write_file path content) +;; + +let setup_toplevel_index_rules sctx = + Output_format.iter ~f:(setup_toplevel_index_rule sctx) ;; let libs_of_pkg ctx ~pkg = @@ -568,11 +607,6 @@ let create_odoc ctx ~target odoc_file = { odoc_file; odocl_file; html_file = file Html; json_file = file Json } ;; -let static_html ctx = - let open Paths in - [ odoc_support ctx; toplevel_index ctx ] -;; - let check_mlds_no_dupes ~pkg ~mlds = match List.rev_map mlds ~f:(fun mld -> @@ -702,12 +736,13 @@ let out_file (output : Output_format.t) odoc = let out_files ctx (output : Output_format.t) odocs = let extra_files = match output with - | Html -> List.map ~f:Path.build (static_html ctx) + | Html -> [ Path.build (Paths.odoc_support ctx) ] | Json -> [] in - List.rev_append - extra_files - (List.map odocs ~f:(fun odoc -> Path.build (out_file output odoc))) + Path.build (Output_format.toplevel_index_path output ctx) + :: List.rev_append + extra_files + (List.map odocs ~f:(fun odoc -> Path.build (out_file output odoc))) ;; let setup_lib_html_rules_def = @@ -911,7 +946,7 @@ let gen_rules sctx ~dir rest = | [ "_html" ] -> let ctx = Super_context.context sctx in let directory_targets = Path.Build.Map.singleton (Paths.odoc_support ctx) Loc.none in - has_rules ~directory_targets (setup_css_rule sctx >>> setup_toplevel_index_rule sctx) + has_rules ~directory_targets (setup_css_rule sctx >>> setup_toplevel_index_rules sctx) | [ "_mlds"; pkg ] -> with_package pkg ~f:(fun pkg -> let* _mlds, rules = package_mlds sctx ~pkg in diff --git a/src/dune_stats/dune_stats.ml b/src/dune_stats/dune_stats.ml index 41e31c76c10..5a3e16bfef0 100644 --- a/src/dune_stats/dune_stats.ml +++ b/src/dune_stats/dune_stats.ml @@ -68,6 +68,7 @@ module Json = struct Buffer.add_char buf '{'; object_body_to_buf o buf; Buffer.add_char buf '}' + | `Null -> Buffer.add_string buf "null" and array_body_to_buf t buf = match t with diff --git a/test/blackbox-tests/test-cases/odoc/doc-json.t b/test/blackbox-tests/test-cases/odoc/doc-json.t index 9323a1a45e7..07b6fef465e 100644 --- a/test/blackbox-tests/test-cases/odoc/doc-json.t +++ b/test/blackbox-tests/test-cases/odoc/doc-json.t @@ -22,15 +22,22 @@ $ dune build @doc-json $ list_docs + _build/default/_doc/_html/index.html.json _build/default/_doc/_html/l/L/M/index.html.json _build/default/_doc/_html/l/L/index.html.json _build/default/_doc/_html/l/index.html.json +The toplevel index is generated by dune itself: + + $ cat _build/default/_doc/_html/index.html.json + {"packages":[{"name":"l","version":null,"link":"l/index.html"}]} + @doc will continue generating doc as usual: $ dune build @doc $ list_docs _build/default/_doc/_html/index.html + _build/default/_doc/_html/index.html.json _build/default/_doc/_html/l/L/M/index.html _build/default/_doc/_html/l/L/M/index.html.json _build/default/_doc/_html/l/L/index.html From ce126dda53d6db40bb862f7684579ee7d9dfeca0 Mon Sep 17 00:00:00 2001 From: Etienne Millon Date: Mon, 18 Sep 2023 15:18:12 +0200 Subject: [PATCH 4/4] Inline html_alias Signed-off-by: Etienne Millon --- src/dune_rules/odoc.ml | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/src/dune_rules/odoc.ml b/src/dune_rules/odoc.ml index ac9a1233758..fd7e3fe34e9 100644 --- a/src/dune_rules/odoc.ml +++ b/src/dune_rules/odoc.ml @@ -155,9 +155,6 @@ module Dep : sig targets produced by odoc for [target] in output format [output]. *) val format_alias : Output_format.t -> Context.t -> target -> Alias.t - (** [html_alias] is [format_alias Html] *) - val html_alias : 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*) @@ -172,7 +169,6 @@ module Dep : sig val setup_deps : Context.t -> target -> Path.Set.t -> unit Memo.t end = struct let format_alias f ctx m = Output_format.alias f ~dir:(Paths.html ctx m) - let html_alias = format_alias Html let alias = Alias.make (Alias.Name.of_string ".odoc-all") let deps ctx pkg requires = @@ -919,7 +915,7 @@ let setup_private_library_doc_alias sctx ~scope ~dir (l : Dune_file.Library.t) = let lib = Lib (Lib.Local.of_lib_exn lib) in Rules.Produce.Alias.add_deps (Alias.make ~dir Alias0.private_doc) - (lib |> Dep.html_alias ctx |> Dune_engine.Dep.alias |> Action_builder.dep) + (lib |> Dep.format_alias Html ctx |> Dune_engine.Dep.alias |> Action_builder.dep) ;; let has_rules ?(directory_targets = Path.Build.Map.empty) m =