From 051e455b95e9e721dc46ef9b74c05dfd3a851278 Mon Sep 17 00:00:00 2001 From: Etienne Millon Date: Tue, 4 Jul 2023 11:32:43 +0200 Subject: [PATCH] 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 --- src/dune_engine/alias.ml | 3 + src/dune_engine/alias.mli | 2 + src/dune_rules/odoc.ml | 121 +++++++++++++----- .../blackbox-tests/test-cases/odoc/doc-json.t | 24 ++++ 4 files changed, 120 insertions(+), 30 deletions(-) create mode 100644 test/blackbox-tests/test-cases/odoc/doc-json.t diff --git a/src/dune_engine/alias.ml b/src/dune_engine/alias.ml index d93b9f49da6d..781e2fd4f012 100644 --- a/src/dune_engine/alias.ml +++ b/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") diff --git a/src/dune_engine/alias.mli b/src/dune_engine/alias.mli index 47216492b5d5..c202f9675950 100644 --- a/src/dune_engine/alias.mli +++ b/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 diff --git a/src/dune_rules/odoc.ml b/src/dune_rules/odoc.ml index 4d856caa4f3c..6958ea955e59 100644 --- a/src/dune_rules/odoc.ml +++ b/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); 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 000000000000..eb6c865ef32b --- /dev/null +++ b/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