diff --git a/src/dune_rules/alias0.ml b/src/dune_rules/alias0.ml index 296d4d7b166..35ff0afe2dc 100644 --- a/src/dune_rules/alias0.ml +++ b/src/dune_rules/alias0.ml @@ -20,6 +20,7 @@ let lint = standard "lint" let private_doc = standard "doc-private" let doc = standard "doc" let doc_json = standard "doc-json" +let doc_markdown = standard "doc-markdown" let doc_new = standard "doc-new" let check = standard "check" let install = standard "install" diff --git a/src/dune_rules/alias0.mli b/src/dune_rules/alias0.mli index 24ca314786d..bdd067885f5 100644 --- a/src/dune_rules/alias0.mli +++ b/src/dune_rules/alias0.mli @@ -7,6 +7,7 @@ module Name := Dune_engine.Alias.Name val fmt : Name.t val doc : Name.t val doc_json : Name.t +val doc_markdown : Name.t val lint : Name.t val private_doc : Name.t val doc_new : Name.t diff --git a/src/dune_rules/odoc.ml b/src/dune_rules/odoc.ml index 8e4da24f371..b98843419f9 100644 --- a/src/dune_rules/odoc.ml +++ b/src/dune_rules/odoc.ml @@ -78,6 +78,7 @@ type odoc_artefact = ; odocl_file : Path.Build.t ; html_file : Path.Build.t ; json_file : Path.Build.t + ; markdown_file : Path.Build.t } let add_rule sctx = @@ -97,6 +98,7 @@ module Paths = struct ;; let html_root ctx = root ctx ++ "_html" + let markdown_root ctx = root ctx ++ "_markdown" let odocl_root ctx = root ctx ++ "_odocls" let add_pkg_lnu base m = @@ -108,40 +110,47 @@ module Paths = struct ;; let html ctx m = add_pkg_lnu (html_root ctx) m + let markdown ctx m = add_pkg_lnu (markdown_root ctx) m let odocl ctx m = add_pkg_lnu (odocl_root ctx) m let gen_mld_dir ctx pkg = root ctx ++ "_mlds" ++ Package.Name.to_string pkg let odoc_support ctx = html_root ctx ++ odoc_support_dirname let toplevel_index ctx = html_root ctx ++ "index.html" + let markdown_index ctx = markdown_root ctx ++ "index.md" end module Output_format = struct type t = | Html | Json + | Markdown - let all = [ Html; Json ] + let all = [ Html; Json; Markdown ] let iter ~f = Memo.parallel_iter all ~f let extension = function | Html -> ".html" | Json -> ".html.json" + | Markdown -> ".md" ;; let args = function | Html -> Command.Args.empty | Json -> A "--as-json" + | Markdown -> Command.Args.empty ;; let target t odoc_file = match t with | Html -> odoc_file.html_file | Json -> odoc_file.json_file + | Markdown -> odoc_file.markdown_file ;; let alias t ~dir = match t with | Html -> Alias.make Alias0.doc ~dir | Json -> Alias.make Alias0.doc_json ~dir + | Markdown -> Alias.make Alias0.doc_markdown ~dir ;; let toplevel_index_path format ctx = @@ -149,9 +158,16 @@ module Output_format = struct match format with | Html -> base | Json -> Path.Build.extend_basename base ~suffix:".json" + | Markdown -> Paths.markdown_index ctx ;; end +let output_dir_for_format ctx format target = + match (format : Output_format.t) with + | Html | Json -> Paths.html ctx target + | Markdown -> Paths.markdown ctx target +;; + module Dep : sig (** [format_alias output ctx target] returns the alias that depends on all targets produced by odoc for [target] in output format [output]. *) @@ -170,7 +186,7 @@ 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 format_alias f ctx m = Output_format.alias f ~dir:(Paths.html ctx m) + let format_alias f ctx m = Output_format.alias f ~dir:(output_dir_for_format ctx f m) let alias = Alias.make (Alias.Name.of_string ".odoc-all") let deps ctx pkg requires = @@ -243,6 +259,49 @@ module Flags = struct ;; end +module Version = struct + type t = int * int * int (* major * minor * patch *) + + let of_string s : t option = + (* strip any suffix *) + let s = + match + String.findi s ~f:(function + | '+' | '-' | '~' -> true + | _ -> false) + with + | None -> s + | Some i -> String.take s i + in + try + match String.split s ~on:'.' with + | [ major; minor; patch ] -> + Some (int_of_string major, int_of_string minor, int_of_string patch) + | [ major; minor ] -> Some (int_of_string major, int_of_string minor, 0) + | _ -> None + with + | _ -> None + ;; + + let compare (ma1, mi1, pa1) (ma2, mi2, pa2) = + match Int.compare ma1 ma2 with + | Ordering.Eq -> + (match Int.compare mi1 mi2 with + | Ordering.Eq -> Int.compare pa1 pa2 + | n -> n) + | n -> n + ;; + + let higher_than_310 version = + match version with + | None -> false + | Some v -> + (match compare v (3, 1, 0) with + | Ordering.Lt -> false + | Ordering.Eq | Ordering.Gt -> true) + ;; +end + let odoc_base_flags quiet build_dir = let open Action_builder.O in let+ conf = Flags.get ~dir:build_dir in @@ -254,6 +313,69 @@ let odoc_base_flags quiet build_dir = | Nonfatal -> S [] ;; +let get_odoc_version_impl bin = + let* _ = Build_system.build_file bin in + Memo.of_reproducible_fiber + @@ + let open Fiber.O in + let+ output, exit_code = + Process.run_capture_lines + ~display:Quiet + ~stderr_to: + (Process.Io.make_stderr + ~output_on_success:Swallow + ~output_limit:Execution_parameters.Action_output_limit.default) + Return + bin + [ "--version" ] + in + output, exit_code +;; + +let odoc_version_memo = + Memo.create "odoc-version" ~input:(module Path) get_odoc_version_impl +;; + +let get_odoc_version odoc_path = + let open Memo.O in + let+ output, exit_code = Memo.exec odoc_version_memo odoc_path in + if exit_code <> 0 + then None + else ( + match output with + | [ version_line ] -> Version.of_string version_line + | _ -> None) +;; + +let odoc_path_memo sctx = + let odoc_dev_tool_lock_dir_exists = + match Config.get Compile_time.lock_dev_tools with + | `Enabled -> true + | `Disabled -> false + in + match odoc_dev_tool_lock_dir_exists with + | true -> + let path = Path.build (Pkg_dev_tool.exe_path Odoc) in + Memo.return (Ok path) + | false -> + let ctx = Super_context.context sctx in + Super_context.resolve_program_memo + sctx + ~dir:(Context.build_dir ctx) + ~where:Original_path + "odoc" + ~loc:None +;; + +let supports_doc_markdown sctx = + let* odoc_prog = odoc_path_memo sctx in + match odoc_prog with + | Error _ -> Memo.return false + | Ok odoc_path -> + let* version = get_odoc_version odoc_path in + Memo.return (Version.higher_than_310 version) +;; + let odoc_dev_tool_exe_path_building_if_necessary () = let open Action_builder.O in let path = Path.build (Pkg_dev_tool.exe_path Odoc) in @@ -399,10 +521,11 @@ let odoc_include_flags ctx pkg requires = let link_odoc_rules sctx (odoc_file : odoc_artefact) ~pkg ~requires = let ctx = Super_context.context sctx in let deps = Dep.deps ctx pkg requires in + let dir = Path.build (Path.Build.parent_exn odoc_file.odocl_file) in let run_odoc = run_odoc sctx - ~dir:(Path.build (Paths.html_root ctx)) + ~dir "link" ~quiet:false ~flags_for:(Some odoc_file.odoc_file) @@ -459,33 +582,50 @@ let setup_library_odoc_rules cctx (local_lib : Lib.Local.t) = let setup_generate sctx ~search_db odoc_file out = let ctx = Super_context.context sctx in let odoc_support_path = Paths.odoc_support ctx in - let search_args = - Sherlodoc.odoc_args sctx ~search_db ~dir_sherlodoc_dot_js:(Paths.html_root ctx) + let command, output_dir, args = + match out with + | Output_format.Markdown -> + ( "markdown-generate" + , Paths.markdown_root ctx + , [ Command.Args.A "-o" + ; Command.Args.Path (Path.build (Paths.markdown_root ctx)) + ; Command.Args.Dep (Path.build odoc_file.odocl_file) + ; Command.Args.Hidden_targets [ Output_format.target out odoc_file ] + ] ) + | Html | Json -> + let search_args = + match search_db with + | None -> Command.Args.empty + | Some search_db -> + Sherlodoc.odoc_args sctx ~search_db ~dir_sherlodoc_dot_js:(Paths.html_root ctx) + in + ( "html-generate" + , Paths.html_root ctx + , [ search_args + ; Command.Args.A "-o" + ; Command.Args.Path (Path.build (Paths.html_root ctx)) + ; Command.Args.A "--support-uri" + ; Command.Args.Path (Path.build odoc_support_path) + ; Command.Args.A "--theme-uri" + ; Command.Args.Path (Path.build odoc_support_path) + ; Command.Args.Dep (Path.build odoc_file.odocl_file) + ; Output_format.args out + ; Command.Args.Hidden_targets [ Output_format.target out odoc_file ] + ] ) in let run_odoc = - run_odoc - sctx - ~dir:(Path.build (Paths.html_root ctx)) - "html-generate" - ~quiet:false - ~flags_for:None - [ search_args - ; A "-o" - ; Path (Path.build (Paths.html_root ctx)) - ; A "--support-uri" - ; Path (Path.build odoc_support_path) - ; A "--theme-uri" - ; Path (Path.build odoc_support_path) - ; Dep (Path.build odoc_file.odocl_file) - ; Output_format.args out - ; Hidden_targets [ Output_format.target out odoc_file ] - ] + run_odoc sctx ~dir:(Path.build output_dir) command ~quiet:false ~flags_for:None args in add_rule sctx run_odoc ;; -let setup_generate_all sctx ~search_db odoc_file = - Output_format.iter ~f:(setup_generate sctx ~search_db odoc_file) +let setup_generate_html_and_json sctx ~search_db odoc_file = + let* () = setup_generate sctx ~search_db:(Some search_db) odoc_file Html in + setup_generate sctx ~search_db:(Some search_db) odoc_file Json +;; + +let setup_generate_markdown sctx odoc_file = + setup_generate sctx ~search_db:None odoc_file Markdown ;; let setup_css_rule sctx = @@ -515,10 +655,15 @@ module Toplevel_index = struct ; link : string } - let of_packages packages = + let of_packages packages output_format = Package.Name.Map.to_list_map packages ~f:(fun name package -> let name = Package.Name.to_string name in - { name; version = Package.version package; link = sp "%s/index.html" name }) + let extension = + match (output_format : Output_format.t) with + | Markdown -> "md" + | Html | Json -> "html" + in + { name; version = Package.version package; link = sp "%s/index.%s" name extension }) ;; let html_list_items t = @@ -581,26 +726,35 @@ module Toplevel_index = struct let json t = Dune_stats.Json.to_string (to_json t) + let markdown t = + let b = Buffer.create 256 in + Buffer.add_string b "# OCaml Package Documentation\n\n"; + List.iter t ~f:(fun { name; version; link } -> + Buffer.add_string b (sp "- [%s](%s)" name link); + (match version with + | None -> () + | Some v -> Buffer.add_string b (sp " (version %s)" (Package_version.to_string v))); + Buffer.add_char b '\n'); + Buffer.contents b + ;; + let content (output : Output_format.t) t = match output with | Html -> html t | Json -> json t + | Markdown -> markdown t ;; end let setup_toplevel_index_rule sctx output = let* packages = Dune_load.packages () in - let index = Toplevel_index.of_packages packages in + let index = Toplevel_index.of_packages packages output in let content = Toplevel_index.content output index in let ctx = Super_context.context sctx in 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 = let+ { Scope.DB.Lib_entry.Set.libraries; _ } = Scope.DB.lib_entries_of_package ctx pkg @@ -634,6 +788,7 @@ let entry_modules sctx ~pkg = let create_odoc ctx ~target odoc_file = let html_base = Paths.html ctx target in + let markdown_base = Paths.markdown ctx target in let odocl_base = Paths.odocl ctx target in let basename = Path.Build.basename odoc_file |> Filename.remove_extension in let odocl_file = odocl_base ++ (basename ^ ".odocl") in @@ -641,16 +796,36 @@ let create_odoc ctx ~target odoc_file = | Lib _ -> let html_dir = html_base ++ Stdune.String.capitalize basename in let file output = - html_dir ++ "index" - |> Path.Build.extend_basename ~suffix:(Output_format.extension output) + match output with + | Output_format.Html | Json -> + html_dir ++ "index" + |> Path.Build.extend_basename ~suffix:(Output_format.extension output) + | Markdown -> + markdown_base ++ Stdune.String.capitalize basename + |> Path.Build.extend_basename ~suffix:(Output_format.extension output) in - { odoc_file; odocl_file; html_file = file Html; json_file = file Json } + { odoc_file + ; odocl_file + ; html_file = file Html + ; json_file = file Json + ; markdown_file = file Markdown + } | Pkg _ -> let file output = - html_base ++ (basename |> String.drop_prefix ~prefix:"page-" |> Option.value_exn) + let base = + match (output : Output_format.t) with + | Markdown -> markdown_base + | Html | Json -> html_base + in + 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 } + { odoc_file + ; odocl_file + ; html_file = file Html + ; json_file = file Json + ; markdown_file = file Markdown + } ;; let check_mlds_no_dupes ~pkg ~mlds = @@ -803,6 +978,7 @@ let out_file (output : Output_format.t) odoc = match output with | Html -> odoc.html_file | Json -> odoc.json_file + | Markdown -> odoc.markdown_file ;; let out_files ctx (output : Output_format.t) odocs = @@ -810,6 +986,7 @@ let out_files ctx (output : Output_format.t) odocs = match output with | Html -> [ Path.build (Paths.odoc_support ctx) ] | Json -> [] + | Markdown -> [] in Path.build (Output_format.toplevel_index_path output ctx) :: List.rev_append @@ -817,6 +994,18 @@ let out_files ctx (output : Output_format.t) odocs = (List.map odocs ~f:(fun odoc -> Path.build (out_file output odoc))) ;; +let add_format_alias_deps ctx format target odocs = + match (format : Output_format.t) with + | Markdown -> + (* skip intermediate aliases since package directories are directory targets *) + Memo.return () + | Html | Json -> + let paths = out_files ctx format odocs in + Rules.Produce.Alias.add_deps + (Dep.format_alias format ctx target) + (Action_builder.paths paths) +;; + let setup_lib_html_rules_def = let module Input = struct module Super_context = Super_context.As_memo_key @@ -832,11 +1021,8 @@ let setup_lib_html_rules_def = let ctx = Super_context.context sctx in let target = Lib lib in let* odocs = odoc_artefacts sctx target 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 target) - (Action_builder.paths paths)) + let* () = add_format_alias_deps ctx Html target odocs in + add_format_alias_deps ctx Json target odocs in Memo.With_implicit_output.create "setup-library-html-rules" @@ -845,6 +1031,30 @@ let setup_lib_html_rules_def = f ;; +let setup_lib_markdown_rules_def = + let module Input = struct + module Super_context = Super_context.As_memo_key + + type t = Super_context.t * Lib.Local.t + + let equal (sc1, l1) (sc2, l2) = Super_context.equal sc1 sc2 && Lib.Local.equal l1 l2 + let hash = Tuple.T2.hash Super_context.hash Lib.Local.hash + let to_dyn _ = Dyn.Opaque + end + in + let f (sctx, lib) = + let ctx = Super_context.context sctx in + let target = Lib lib in + let* odocs = odoc_artefacts sctx target in + add_format_alias_deps ctx Markdown target odocs + in + Memo.With_implicit_output.create + "setup-library-markdown-rules" + ~implicit_output:Rules.implicit_output + ~input:(module Input) + f +;; + let search_db_for_lib sctx lib = let target = Lib lib in let ctx = Super_context.context sctx in @@ -858,7 +1068,8 @@ let setup_lib_html_rules sctx ~search_db lib = let target = Lib lib in let* odocs = odoc_artefacts sctx target in let* () = - Memo.parallel_iter odocs ~f:(fun odoc -> setup_generate_all sctx ~search_db odoc) + Memo.parallel_iter odocs ~f:(fun odoc -> + setup_generate_html_and_json sctx ~search_db odoc) in Memo.With_implicit_output.exec setup_lib_html_rules_def (sctx, lib) ;; @@ -878,12 +1089,11 @@ let setup_pkg_html_rules_def = Sherlodoc.search_db sctx ~dir ~external_odocls:[] odocls in let* () = Memo.parallel_iter libs ~f:(setup_lib_html_rules sctx ~search_db) in - let* () = Memo.parallel_iter pkg_odocs ~f:(setup_generate_all ~search_db sctx) in - Output_format.iter ~f:(fun output -> - let paths = out_files ctx output all_odocs in - Rules.Produce.Alias.add_deps - (Dep.format_alias output ctx (Pkg pkg)) - (Action_builder.paths paths)) + let* () = + Memo.parallel_iter pkg_odocs ~f:(setup_generate_html_and_json ~search_db sctx) + in + let* () = add_format_alias_deps ctx Html (Pkg pkg) all_odocs in + add_format_alias_deps ctx Json (Pkg pkg) all_odocs in setup_pkg_rules_def "setup-package-html-rules" f ;; @@ -892,22 +1102,132 @@ let setup_pkg_html_rules sctx ~pkg : unit Memo.t = Memo.With_implicit_output.exec setup_pkg_html_rules_def (sctx, pkg) ;; +let setup_lib_markdown_rules sctx lib = + let* markdown_supported = supports_doc_markdown sctx in + if not markdown_supported + then Memo.return () + else ( + let target = Lib lib in + let* odocs = odoc_artefacts sctx target in + let* () = + (* because libraries with a package are handled in the package-level rule with the system shell script for all directory target, we skip packages *) + match Lib_info.package (Lib.Local.info lib) with + | Some _ -> Memo.return () + | None -> + (* when there's no package, we still need have rules for each odoc file *) + Memo.parallel_iter odocs ~f:(fun odoc -> setup_generate_markdown sctx odoc) + in + Memo.With_implicit_output.exec setup_lib_markdown_rules_def (sctx, lib)) +;; + +let markdown_shell_command odoc_path all_odocs ~markdown_root = + List.map all_odocs ~f:(fun odoc -> + let odocl_rel = + Path.reach (Path.build odoc.odocl_file) ~from:(Path.build markdown_root) + in + Printf.sprintf "%s markdown-generate -o . %s" odoc_path odocl_rel) + |> String.concat ~sep:" && " +;; + +let setup_pkg_markdown_rules_def = + let f (sctx, pkg) = + let ctx = Super_context.context sctx in + let* markdown_supported = supports_doc_markdown sctx in + if not markdown_supported + then Memo.return () + else + let* libs = Context.name ctx |> libs_of_pkg ~pkg in + let* pkg_odocs = odoc_artefacts sctx (Pkg pkg) in + let* lib_odocs = + Memo.List.concat_map libs ~f:(fun lib -> odoc_artefacts sctx (Lib lib)) + in + let all_odocs = pkg_odocs @ lib_odocs in + (* odoc generates all markdown files on the same level for the package so we use one rule with directory target and batch all odoc commands. *) + let* () = + if List.is_empty all_odocs + then Memo.return () + else ( + let pkg_markdown_dir = Paths.markdown ctx (Pkg pkg) in + let markdown_root = Paths.markdown_root ctx in + let rule = + let prog, shell_arg = + Env_path.system_shell_exn ~needed_to:"generate markdown documentation" + in + let system_shell_cmd_args = + let open Action_builder.O in + let* odoc_prog = odoc_program sctx (Context.build_dir ctx) in + let odoc_path = Action.Prog.ok_exn odoc_prog |> Path.to_string in + let shell_cmd = markdown_shell_command odoc_path all_odocs ~markdown_root in + let* () = + List.map all_odocs ~f:(fun odoc -> + Action_builder.path (Path.build odoc.odocl_file)) + |> Action_builder.all + >>| ignore + in + Action_builder.return (Command.Args.S [ A shell_arg; A shell_cmd ]) + in + let deps = Action_builder.env_var "ODOC_SYNTAX" in + let open Action_builder.With_targets.O in + Action_builder.with_no_targets deps + >>> Command.run + ~dir:(Path.build markdown_root) + (Ok prog) + [ Dyn system_shell_cmd_args ] + |> Action_builder.With_targets.add_directories + ~directory_targets:[ pkg_markdown_dir ] + in + add_rule sctx rule) + in + let* () = Memo.parallel_iter libs ~f:(setup_lib_markdown_rules sctx) in + add_format_alias_deps ctx Markdown (Pkg pkg) all_odocs + in + setup_pkg_rules_def "setup-package-markdown-rules" f +;; + +let setup_pkg_markdown_rules sctx ~pkg : unit Memo.t = + Memo.With_implicit_output.exec setup_pkg_markdown_rules_def (sctx, pkg) +;; + 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 - Output_format.alias output ~dir - in - let* libs = - Context.name ctx |> libs_of_pkg ~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 + match (output : Output_format.t) with + | Markdown -> + let* is_markdown_supported = supports_doc_markdown sctx in + if not is_markdown_supported + then Memo.return () + else ( + 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 + Output_format.alias output ~dir + in + let directory_target = Paths.markdown ctx (Pkg name) in + let toplevel_index = Paths.markdown_index ctx in + let deps = + let open Action_builder.O in + let+ () = Action_builder.path (Path.build directory_target) + and+ () = Action_builder.path (Path.build toplevel_index) in + () + in + Rules.Produce.Alias.add_deps alias deps) + | Html | Json -> + 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 + Output_format.alias output ~dir + in + let* libs = + Context.name ctx |> libs_of_pkg ~pkg:name >>| List.map ~f:(fun lib -> Lib lib) + in + let deps = + 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 + in + Rules.Produce.Alias.add_deps alias deps ;; let setup_package_aliases sctx (pkg : Package.t) = @@ -1041,7 +1361,35 @@ let gen_rules sctx ~dir rest = ~directory_targets (Sherlodoc.sherlodoc_dot_js sctx ~dir:(Paths.html_root ctx) >>> setup_css_rule sctx - >>> setup_toplevel_index_rules sctx) + >>> setup_toplevel_index_rule sctx Html + >>> setup_toplevel_index_rule sctx Json) + | [ "_markdown" ] -> + let* packages = Dune_load.packages () in + let ctx = Super_context.context sctx in + let* is_markdown_supported = supports_doc_markdown sctx in + if not is_markdown_supported + then Memo.return Gen_rules.no_rules + else ( + let all_package_dirs = + Package.Name.Map.to_list packages + |> List.map ~f:(fun (_, (pkg : Package.t)) -> + let pkg_name = Package.name pkg in + Paths.markdown ctx (Pkg pkg_name)) + in + let directory_targets = + List.fold_left all_package_dirs ~init:Path.Build.Map.empty ~f:(fun acc dir -> + Path.Build.Map.set acc dir Loc.none) + in + has_rules + ~directory_targets + (let* () = setup_toplevel_index_rule sctx Markdown in + Package.Name.Map.to_seq packages + |> Memo.parallel_iter_seq ~f:(fun (_, (pkg : Package.t)) -> + let pkg_name = Package.name pkg in + setup_pkg_markdown_rules sctx ~pkg:pkg_name))) + | [ "_markdown"; _lib_unique_name_or_pkg ] -> + (* package directories are directory targets *) + Memo.return Gen_rules.no_rules | [ "_mlds"; pkg ] -> with_package pkg ~f:(fun pkg -> let pkg = Package.name pkg in diff --git a/test/blackbox-tests/test-cases/odoc/doc-markdown.t b/test/blackbox-tests/test-cases/odoc/doc-markdown.t new file mode 100644 index 00000000000..a0dc408e08a --- /dev/null +++ b/test/blackbox-tests/test-cases/odoc/doc-markdown.t @@ -0,0 +1,62 @@ + $ cat > dune-project << EOF + > (lang dune 3.10) + > + > (package + > (name mylib)) + > EOF + + $ cat > dune << EOF + > (library + > (public_name mylib)) + > EOF + + $ cat > mylib.ml << EOF + > (** This is the main module for mylib *) + > + > (** A simple type definition *) + > type t = int + > + > (** A function that adds one *) + > val add_one : int -> int + > let add_one x = x + 1 + > + > module SubModule = struct + > (** A nested module *) + > type nested = string + > end + > EOF + + $ cat > mylib.mli << EOF + > (** This is the main module for mylib *) + > + > (** A simple type definition *) + > type t = int + > + > (** A function that adds one *) + > val add_one : int -> int + > + > module SubModule : sig + > (** A nested module *) + > type nested = string + > end + > EOF + + $ list_markdown_docs () { + > find _build/default/_doc/_markdown -name '*.md' | sort + > } + +Build markdown documentation: + + $ dune build @doc-markdown + $ list_markdown_docs + _build/default/_doc/_markdown/index.md + _build/default/_doc/_markdown/mylib/Mylib-SubModule.md + _build/default/_doc/_markdown/mylib/Mylib.md + _build/default/_doc/_markdown/mylib/index.md + +Check the top-level index contains markdown: + + $ cat _build/default/_doc/_markdown/index.md + # OCaml Package Documentation + + - [mylib](mylib/index.md) diff --git a/test/blackbox-tests/test-cases/odoc/markdown-modules.t/main.ml b/test/blackbox-tests/test-cases/odoc/markdown-modules.t/main.ml new file mode 100644 index 00000000000..5990dbe2725 --- /dev/null +++ b/test/blackbox-tests/test-cases/odoc/markdown-modules.t/main.ml @@ -0,0 +1,4 @@ +let x = 42 + +module Sub = Main_sub +module Nested = Main_nested \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/odoc/markdown-modules.t/main.mli b/test/blackbox-tests/test-cases/odoc/markdown-modules.t/main.mli new file mode 100644 index 00000000000..ab95e4c0f20 --- /dev/null +++ b/test/blackbox-tests/test-cases/odoc/markdown-modules.t/main.mli @@ -0,0 +1,8 @@ +(** Main module *) +val x : int + +(** Sub module *) +module Sub = Main_sub + +(** Nested module *) +module Nested = Main_nested diff --git a/test/blackbox-tests/test-cases/odoc/markdown-modules.t/main_nested.ml b/test/blackbox-tests/test-cases/odoc/markdown-modules.t/main_nested.ml new file mode 100644 index 00000000000..59cb6e62a7a --- /dev/null +++ b/test/blackbox-tests/test-cases/odoc/markdown-modules.t/main_nested.ml @@ -0,0 +1,3 @@ +let z = true + +module Nested_deep = Main_nested_deep \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/odoc/markdown-modules.t/main_nested.mli b/test/blackbox-tests/test-cases/odoc/markdown-modules.t/main_nested.mli new file mode 100644 index 00000000000..df000074ed5 --- /dev/null +++ b/test/blackbox-tests/test-cases/odoc/markdown-modules.t/main_nested.mli @@ -0,0 +1,4 @@ +(** Nested module *) +val z : bool + +module Nested_deep = Main_nested_deep \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/odoc/markdown-modules.t/main_nested_deep.ml b/test/blackbox-tests/test-cases/odoc/markdown-modules.t/main_nested_deep.ml new file mode 100644 index 00000000000..562bc739f7a --- /dev/null +++ b/test/blackbox-tests/test-cases/odoc/markdown-modules.t/main_nested_deep.ml @@ -0,0 +1 @@ +let w = 3.14 diff --git a/test/blackbox-tests/test-cases/odoc/markdown-modules.t/main_nested_deep.mli b/test/blackbox-tests/test-cases/odoc/markdown-modules.t/main_nested_deep.mli new file mode 100644 index 00000000000..3952fdb9542 --- /dev/null +++ b/test/blackbox-tests/test-cases/odoc/markdown-modules.t/main_nested_deep.mli @@ -0,0 +1,2 @@ +(** Main nested deep module *) +val w : float diff --git a/test/blackbox-tests/test-cases/odoc/markdown-modules.t/main_sub.ml b/test/blackbox-tests/test-cases/odoc/markdown-modules.t/main_sub.ml new file mode 100644 index 00000000000..3d6a356065d --- /dev/null +++ b/test/blackbox-tests/test-cases/odoc/markdown-modules.t/main_sub.ml @@ -0,0 +1 @@ +let y = "hello" diff --git a/test/blackbox-tests/test-cases/odoc/markdown-modules.t/main_sub.mli b/test/blackbox-tests/test-cases/odoc/markdown-modules.t/main_sub.mli new file mode 100644 index 00000000000..faa6f6aa0b8 --- /dev/null +++ b/test/blackbox-tests/test-cases/odoc/markdown-modules.t/main_sub.mli @@ -0,0 +1,2 @@ +(** Sub module *) +val y : string diff --git a/test/blackbox-tests/test-cases/odoc/markdown-modules.t/run.t b/test/blackbox-tests/test-cases/odoc/markdown-modules.t/run.t new file mode 100644 index 00000000000..fab438e20c3 --- /dev/null +++ b/test/blackbox-tests/test-cases/odoc/markdown-modules.t/run.t @@ -0,0 +1,46 @@ +Test that markdown generation includes all modules following naming conventions. + + $ cat > dune-project << EOF + > (lang dune 3.0) + > (package (name mylib)) + > EOF + + $ cat > dune << EOF + > (library + > (public_name mylib)) + > EOF + +Build the library and generate docs: + + $ dune build @doc-markdown + +Check what markdown files were generated: + + $ find _build/default/_doc/_markdown -name "*.md" | sort + _build/default/_doc/_markdown/index.md + _build/default/_doc/_markdown/mylib/Mylib-Main.md + _build/default/_doc/_markdown/mylib/Mylib-Main_nested.md + _build/default/_doc/_markdown/mylib/Mylib-Main_nested_deep.md + _build/default/_doc/_markdown/mylib/Mylib-Main_sub.md + _build/default/_doc/_markdown/mylib/Mylib.md + _build/default/_doc/_markdown/mylib/index.md + +Great! All modules are being generated as separate files. +Let's verify that the content is correct: + + $ cat _build/default/_doc/_markdown/mylib/Mylib.md + + # Module `Mylib` + + ``` + module Main : sig ... end + ``` + ``` + module Main_nested : sig ... end + ``` + ``` + module Main_nested_deep : sig ... end + ``` + ``` + module Main_sub : sig ... end + ``` diff --git a/test/blackbox-tests/test-cases/odoc/markdown-with-mld.t b/test/blackbox-tests/test-cases/odoc/markdown-with-mld.t new file mode 100644 index 00000000000..9aff16f889d --- /dev/null +++ b/test/blackbox-tests/test-cases/odoc/markdown-with-mld.t @@ -0,0 +1,69 @@ +Test markdown generation with package documentation (.mld files) + + $ cat > dune-project << EOF + > (lang dune 3.10) + > (package + > (name example)) + > EOF + + $ cat > dune << EOF + > (library + > (public_name example)) + > EOF + + $ cat > example.ml << EOF + > (** Example library module *) + > + > let greet name = Printf.sprintf "Hello, %s!" name + > EOF + +Create a package documentation file: + + $ cat > index.mld << EOF + > {0 Example Package} + > + > This is the documentation for the example package. + > + > {1 Overview} + > + > This package provides a simple greeting function. + > + > {2 Usage} + > + > {[ + > let message = Example.greet "World" + > ]} + > + > See {!Example} for the API documentation. + > EOF + +Build the markdown documentation: + + $ dune build @doc-markdown + +Check that markdown files are generated: + + $ find _build/default/_doc/_markdown -name '*.md' | sort + _build/default/_doc/_markdown/example/Example.md + _build/default/_doc/_markdown/example/index.md + _build/default/_doc/_markdown/index.md + +The package-level documentation should be present: + + $ ls _build/default/_doc/_markdown/example/ + Example.md + index.md + +Test building documentation from current directory (where the package is defined): + + $ dune build @doc-markdown + +Verify that both HTML and markdown can coexist: + + $ dune build @doc @doc-markdown + $ find _build/default/_doc -name 'index.*' | grep -E '(html|md)$' | sort + _build/default/_doc/_html/example/Example/index.html + _build/default/_doc/_html/example/index.html + _build/default/_doc/_html/index.html + _build/default/_doc/_markdown/example/index.md + _build/default/_doc/_markdown/index.md diff --git a/test/blackbox-tests/test-cases/odoc/odoc-markdown-version-check.t b/test/blackbox-tests/test-cases/odoc/odoc-markdown-version-check.t new file mode 100644 index 00000000000..d133763e0c1 --- /dev/null +++ b/test/blackbox-tests/test-cases/odoc/odoc-markdown-version-check.t @@ -0,0 +1,214 @@ +Testing that odoc markdown generation is only enabled with odoc >= 3.1.0 + +Create a simple project with odoc documentation: + $ cat > dune-project < (lang dune 3.0) + > (package (name foo)) + > EOF + + $ cat > dune < (library + > (public_name foo) + > (name foo)) + > EOF + + $ cat > foo.ml < (** This is a test module *) + > let x = 42 + > EOF + + $ cat > foo.mli < (** This is the interface for the test module *) + > val x : int + > (** The answer to everything *) + > EOF + + $ cat > odoc << 'EOF' + > #!/bin/bash + > case "$1" in + > --version) + > echo "2.0.0" + > ;; + > compile | compile-index) + > # Find the -o flag and create the output file + > output="" + > while [[ $# -gt 0 ]]; do + > if [[ "$1" == "-o" && -n "$2" ]]; then + > output="$2" + > shift 2 + > else + > shift + > fi + > done + > if [[ -n "$output" ]]; then + > mkdir -p $(dirname "$output") + > touch "$output" + > fi + > exit 0;; + > link) + > # Find the -o flag and create the output .odocl file + > output="" + > while [[ $# -gt 0 ]]; do + > if [[ "$1" == "-o" && -n "$2" ]]; then + > output="$2" + > shift 2 + > else + > shift + > fi + > done + > if [[ -n "$output" ]]; then + > mkdir -p $(dirname "$output") + > touch "$output" + > fi + > exit 0;; + > html-generate) + > # Find the -o flag and create output directory + > while [[ $# -gt 0 ]]; do + > if [[ "$1" == "-o" && -n "$2" ]]; then + > mkdir -p "$2" + > break + > fi + > shift + > done + > exit 0;; + > support-files) exit 0;; + > *) exit 0;; + > esac + > EOF + $ chmod +x odoc + $ PATH=.:$PATH dune build @doc-markdown + $ ls _build/default/_doc/_markdown 2>/dev/null || echo "No markdown directory created (expected for odoc 2.0.0)" + No markdown directory created (expected for odoc 2.0.0) + + $ cat > odoc << 'EOF' + > #!/bin/bash + > case "$1" in + > --version) + > echo "3.1.0" + > ;; + > compile | compile-index) + > # Find the -o flag and create the output file + > output="" + > while [[ $# -gt 0 ]]; do + > if [[ "$1" == "-o" && -n "$2" ]]; then + > output="$2" + > shift 2 + > else + > shift + > fi + > done + > if [[ -n "$output" ]]; then + > mkdir -p $(dirname "$output") + > touch "$output" + > fi + > exit 0;; + > link) + > # Find the -o flag and create the output .odocl file + > output="" + > while [[ $# -gt 0 ]]; do + > if [[ "$1" == "-o" && -n "$2" ]]; then + > output="$2" + > shift 2 + > else + > shift + > fi + > done + > if [[ -n "$output" ]]; then + > mkdir -p $(dirname "$output") + > touch "$output" + > fi + > exit 0;; + > html-generate) + > # Find the -o flag and create output directory + > while [[ $# -gt 0 ]]; do + > if [[ "$1" == "-o" && -n "$2" ]]; then + > mkdir -p "$2" + > break + > fi + > shift + > done + > exit 0;; + > markdown-generate) + > # Find the -o flag and create markdown files + > while [[ $# -gt 0 ]]; do + > if [[ "$1" == "-o" && -n "$2" ]]; then + > mkdir -p "$2" + > # Create some dummy markdown files to satisfy the build + > touch "$2/index.md" + > mkdir -p "$2/foo" + > touch "$2/foo/index.md" + > break + > fi + > shift + > done + > exit 0;; + > support-files) exit 0;; + > *) exit 0;; + > esac + > EOF + $ chmod +x odoc + + $ PATH=.:$PATH dune build @doc-markdown + $ ls _build/default/_doc/_markdown/foo/index.md 2>/dev/null && echo "Markdown files created (expected for odoc 3.1.0)" + _build/default/_doc/_markdown/foo/index.md + Markdown files created (expected for odoc 3.1.0) + + $ rm -rf _build + $ cat > odoc << 'EOF' + > #!/bin/bash + > case "$1" in + > --version) + > echo "not a valid version" + > ;; + > compile | compile-index) + > # Find the -o flag and create the output file + > output="" + > while [[ $# -gt 0 ]]; do + > if [[ "$1" == "-o" && -n "$2" ]]; then + > output="$2" + > shift 2 + > else + > shift + > fi + > done + > if [[ -n "$output" ]]; then + > mkdir -p $(dirname "$output") + > touch "$output" + > fi + > exit 0;; + > link) + > # Find the -o flag and create the output .odocl file + > output="" + > while [[ $# -gt 0 ]]; do + > if [[ "$1" == "-o" && -n "$2" ]]; then + > output="$2" + > shift 2 + > else + > shift + > fi + > done + > if [[ -n "$output" ]]; then + > mkdir -p $(dirname "$output") + > touch "$output" + > fi + > exit 0;; + > html-generate) + > # Find the -o flag and create output directory + > while [[ $# -gt 0 ]]; do + > if [[ "$1" == "-o" && -n "$2" ]]; then + > mkdir -p "$2" + > break + > fi + > shift + > done + > exit 0;; + > support-files) exit 0;; + > *) exit 0;; + > esac + > EOF + $ chmod +x odoc + + $ PATH=.:$PATH dune build @doc-markdown + $ ls _build/default/_doc/_markdown + ls: _build/default/_doc/_markdown: No such file or directory + [1]