From 1f461f6e5eae4d84966ef1ed12263f71b7f7fa3d Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Tue, 30 Jul 2024 17:28:08 +0200 Subject: [PATCH 1/9] Driver: generate external pages Generate pages that are external of a package: landing pages for package, library, library list and package list. There is a problem currently with empty parent id. Currently using a "`a`" container directory for the package list. --- src/driver/compile.ml | 20 ++- src/driver/landing_pages.ml | 252 ++++++++++++++++++++++++++++++++++++ src/driver/odoc_driver.ml | 18 ++- src/driver/odoc_unit.ml | 4 +- src/driver/odoc_unit.mli | 2 +- 5 files changed, 286 insertions(+), 10 deletions(-) create mode 100644 src/driver/landing_pages.ml diff --git a/src/driver/compile.ml b/src/driver/compile.ml index d42154fa4a..1f66f23912 100644 --- a/src/driver/compile.ml +++ b/src/driver/compile.ml @@ -22,7 +22,11 @@ let init_stats (units : Odoc_unit.t list) = let assets = match unit.kind with `Asset -> assets + 1 | _ -> assets in - let indexes = Fpath.Set.add unit.index.output_file indexes in + let indexes = + match unit.index with + | None -> indexes + | Some index -> Fpath.Set.add index.output_file indexes + in let non_hidden = match unit.kind with | `Intf { hidden = false; _ } -> non_hidden + 1 @@ -256,10 +260,16 @@ let html_generate output_dir linked = Odoc.html_generate_asset ~output_dir ~input_file:l.odoc_file ~asset_path:l.input_file () | _ -> - let db_path = compile_index l.index in - let search_uris = [ db_path; Sherlodoc.js_file ] in - let index = l.index.output_file in - Odoc.html_generate ~search_uris ~index ~output_dir ~input_file (); + let search_uris, index = + match l.index with + | None -> (None, None) + | Some index -> + let db_path = compile_index index in + let search_uris = [ db_path; Sherlodoc.js_file ] in + let index = index.output_file in + (Some search_uris, Some index) + in + Odoc.html_generate ?search_uris ?index ~output_dir ~input_file (); Atomic.incr Stats.stats.generated_units in Fiber.List.iter html_generate linked diff --git a/src/driver/landing_pages.ml b/src/driver/landing_pages.ml new file mode 100644 index 0000000000..32ea9db1c6 --- /dev/null +++ b/src/driver/landing_pages.ml @@ -0,0 +1,252 @@ +open Packages + +let pkg_landing_page_content pkg = + let title = Format.sprintf "{0 %s}\n" pkg.name in + let documentation = + match pkg.mlds with + | _ :: _ -> + Format.sprintf + "{1 Documentation pages}\n\n{{!/%s/doc/index}Documentation for %s}\n" + pkg.name pkg.name + | [] -> "" + in + let libraries = + match pkg.libraries with + | [] -> "" + | _ :: _ -> + Format.sprintf "{1 Libraries}\n\n{{!/%s/lib/index}Libraries for %s}\n" + pkg.name pkg.name + in + title ^ documentation ^ libraries + +let library_landing_page_content lib = + let title = Format.sprintf "{0 %s}\n" lib.lib_name in + let s_of_module m = + if m.m_hidden then None + else Some (Format.sprintf "- {!%s}" m.Packages.m_name) + in + let modules = + lib.modules |> List.filter_map s_of_module |> String.concat "\n" + in + title ^ modules + +let libraries_landing_page_content pkg = + let title = Format.sprintf "{0 %s}\n" pkg.name in + let s_of_lib (lib : Packages.libty) = + Format.sprintf "- {{!/%s/%s/index}%s}" pkg.name lib.lib_name lib.lib_name + in + let libraries = pkg.libraries |> List.map s_of_lib |> String.concat "\n" in + title ^ libraries + +let list_packages_content all = + let sorted_packages = + all |> List.sort (fun n1 n2 -> String.compare n1.name n2.name) + in + let title = "{0 List of all packages}\n" in + let s_of_pkg pkg = Format.sprintf "- {{!/%s/index}%s}" pkg.name pkg.name in + let pkg_ul = sorted_packages |> List.map s_of_pkg |> String.concat "\n" in + title ^ pkg_ul + +let write_file file content = Bos.OS.File.write file content |> Result.get_ok + +let of_package ~mld_dir ~odoc_dir ~odocl_dir ~output_dir pkg = + let make_unit rel_path ~content ?(include_dirs = []) ~pkgname ~pkg_args () = + let input_file = Fpath.(mld_dir // rel_path / "index.mld") in + let odoc_file = Fpath.(odoc_dir // rel_path / "page-index.odoc") in + let odocl_file = Fpath.(odocl_dir // rel_path / "page-index.odocl") in + let () = write_file input_file content in + let parent_id = rel_path |> Odoc.id_of_fpath in + let open Odoc_unit in + { + parent_id; + odoc_dir; + input_file; + output_dir; + odoc_file; + odocl_file; + pkg_args; + pkgname; + include_dirs; + index = None; + kind = `Mld; + } + in + let library_list_page = + let open Odoc_unit in + let content = libraries_landing_page_content pkg in + let rel_path = Fpath.(v pkg.name / "lib") in + let pkg_args = + { pages = [ (pkg.name, Fpath.( // ) odoc_dir rel_path) ]; libs = [] } + in + make_unit rel_path ~content ~pkgname:pkg.name ~pkg_args () + in + let library_landing_pages = + let do_ lib = + let open Odoc_unit in + let content = library_landing_page_content lib in + let rel_path = Fpath.(v pkg.name / "lib" / lib.lib_name) in + let pkg_args = + { pages = [ (pkg.name, Fpath.( // ) odoc_dir rel_path) ]; libs = [] } + in + let include_dirs = [ Fpath.(odoc_dir // rel_path) ] in + make_unit rel_path ~content ~pkgname:pkg.name ~include_dirs ~pkg_args () + in + List.map do_ pkg.libraries + in + let package_landing_page = + let open Odoc_unit in + let content = pkg_landing_page_content pkg in + let rel_path = Fpath.v pkg.name in + let pkg_args = + { pages = [ (pkg.name, Fpath.( // ) odoc_dir rel_path) ]; libs = [] } + in + make_unit rel_path ~content ~pkgname:pkg.name ~pkg_args () + in + package_landing_page :: library_list_page :: library_landing_pages + +let of_packages ~mld_dir ~odoc_dir ~odocl_dir ~output_dir all = + let content = list_packages_content all in + let rel_path = Fpath.v "a" in + let input_file = Fpath.(mld_dir // rel_path / "index.mld") in + let () = write_file input_file content in + let open Odoc_unit in + let parent_id = rel_path |> Odoc.id_of_fpath in + let pkgname = "__driver" in + let pkg_args = + { + pages = + (pkgname, Fpath.(odoc_dir // rel_path)) + :: List.map (fun pkg -> (pkg.name, Fpath.(odoc_dir / pkg.name))) all; + libs = []; + } + in + { + parent_id; + odoc_dir; + input_file; + output_dir; + pkg_args; + pkgname; + odoc_file = Fpath.(odoc_dir // rel_path / "page-index.odoc"); + odocl_file = Fpath.(odocl_dir // rel_path / "page-index.odocl"); + include_dirs = []; + index = None; + kind = `Mld; + } + :: List.concat_map (of_package ~mld_dir ~odoc_dir ~odocl_dir ~output_dir) all + +(* let compile_list_packages odoc_dir all : compiled = *) +(* let sorted_packages = *) +(* all |> Util.StringMap.to_list *) +(* |> List.sort (fun (n1, _) (n2, _) -> String.compare n1 n2) *) +(* in *) +(* let title = "{0 List of all packages}\n" in *) +(* let s_of_pkg (name, _) = Format.sprintf "- {{!%s/index}%s}" name name in *) +(* let pkg_ul = sorted_packages |> List.map s_of_pkg |> String.concat "\n" in *) +(* let content = title ^ pkg_ul in *) +(* let input_file = Fpath.( / ) odoc_dir "index.mld" in *) +(* let () = Bos.OS.File.write input_file content |> Result.get_ok in *) +(* Odoc.compile ~output_dir:odoc_dir ~input_file ~includes:Fpath.Set.empty *) +(* ~parent_id:(Odoc.id_of_fpath (Fpath.v "./")); *) +(* Atomic.incr Stats.stats.compiled_mlds; *) +(* { *) +(* m = Mld; *) +(* odoc_output_dir = odoc_dir; *) +(* odoc_file = Fpath.(odoc_dir / "page-index.odoc"); *) +(* odocl_file = Fpath.(odoc_dir / "page-index.odocl"); *) +(* include_dirs = Fpath.Set.empty; *) +(* impl = None; *) +(* pkg_args = { docs = [ ("_driver_pkg", odoc_dir) ]; libs = [] }; *) +(* pkgname = { p_name = "_driver_pkg"; p_dir = Fpath.v "./" }; *) +(* } *) + +(* let compile_landing_pages odoc_dir pkg : compiled list = *) +(* let pkgname = pkg.Packages.pkgname in *) +(* let driver_page ~odoc_file ~odocl_file ?(include_dirs = Fpath.Set.empty) () = *) +(* let pkg_args = *) +(* { *) +(* docs = [ (pkgname.p_name, Fpath.( / ) odoc_dir pkgname.p_name) ]; *) +(* libs = []; *) +(* } *) +(* in *) +(* { *) +(* m = Mld; *) +(* odoc_output_dir = odoc_dir; *) +(* odoc_file; *) +(* odocl_file; *) +(* include_dirs; *) +(* impl = None; *) +(* pkg_args; *) +(* pkgname; *) +(* } *) +(* in *) +(* let title = Format.sprintf "{0 %s}\n" in *) +(* let compile ~content ~input_file ?(include_dirs = Fpath.Set.empty) ~parent_id *) +(* () = *) +(* let () = Bos.OS.File.write input_file content |> Result.get_ok in *) +(* Odoc.compile ~output_dir:odoc_dir ~input_file ~includes:include_dirs *) +(* ~parent_id; *) +(* Atomic.incr Stats.stats.compiled_mlds; *) +(* ( Fpath.(odoc_dir // Odoc.fpath_of_id parent_id / "page-index.odoc"), *) +(* Fpath.(odoc_dir // Odoc.fpath_of_id parent_id / "page-index.odocl") ) *) +(* in *) + +(* let library_landing_page pkgname (lib : Packages.libty) : compiled = *) +(* let libname = lib.lib_name in *) +(* let parent_id = *) +(* Fpath.(v pkgname.Packages.p_name / "lib" / libname) |> Odoc.id_of_fpath *) +(* in *) +(* let input_file = *) +(* Fpath.(odoc_dir // Odoc.fpath_of_id parent_id / "index.mld") *) +(* in *) +(* let s_of_module m = Format.sprintf "- {!%s}" m.Packages.m_name in *) +(* let modules = lib.modules |> List.map s_of_module |> String.concat "\n" in *) +(* let content = title libname ^ modules in *) +(* let include_dirs = *) +(* Fpath.(Set.empty |> Set.add (odoc_dir // Odoc.fpath_of_id parent_id)) *) +(* in *) +(* let odoc_file, odocl_file = *) +(* compile ~content ~input_file ~include_dirs ~parent_id () *) +(* in *) +(* driver_page ~odoc_file ~odocl_file ~include_dirs () *) +(* in *) + +(* let libraries_landing_page pkg : compiled list = *) +(* let pkgname = pkg.Packages.pkgname in *) +(* let parent_id = Fpath.(v pkgname.p_name / "lib") |> Odoc.id_of_fpath in *) +(* let input_file = *) +(* Fpath.(odoc_dir // Odoc.fpath_of_id parent_id / "index.mld") *) +(* in *) +(* let s_of_lib (lib : Packages.libty) = *) +(* Format.sprintf "- {{!%s/index}%s}" lib.lib_name lib.lib_name *) +(* in *) +(* let libraries = pkg.libraries |> List.map s_of_lib |> String.concat "\n" in *) +(* let content = title pkgname.p_name ^ libraries in *) +(* let odoc_file, odocl_file = compile ~content ~input_file ~parent_id () in *) +(* driver_page ~odoc_file ~odocl_file () *) +(* :: List.map (library_landing_page pkgname) pkg.libraries *) +(* in *) + +(* let package_landing_page = *) +(* let input_file = Fpath.(odoc_dir // v pkgname.p_name / "index.mld") in *) +(* let documentation = *) +(* match pkg.mlds with *) +(* | _ :: _ -> *) +(* Format.sprintf *) +(* "{1 Documentation pages}\n\n{{!doc/index}Documentation for %s}" *) +(* pkgname.p_name *) +(* | [] -> "" *) +(* in *) +(* let libraries = *) +(* match pkg.libraries with *) +(* | [] -> "" *) +(* | _ :: _ -> *) +(* Format.sprintf "{1 Libraries}\n\n{{!lib/index}Libraries for %s}" *) +(* pkgname.p_name *) +(* in *) +(* let content = title pkgname.p_name ^ documentation ^ libraries in *) +(* let parent_id = Odoc.id_of_fpath (Fpath.v pkgname.p_name) in *) +(* let odoc_file, odocl_file = compile ~content ~input_file ~parent_id () in *) +(* driver_page ~odoc_file ~odocl_file () *) +(* in *) +(* package_landing_page :: libraries_landing_page pkg *) diff --git a/src/driver/odoc_driver.ml b/src/driver/odoc_driver.ml index 7d92dfc365..1158055292 100644 --- a/src/driver/odoc_driver.ml +++ b/src/driver/odoc_driver.ml @@ -558,8 +558,17 @@ let run libs verbose packages_dir odoc_dir odocl_dir html_dir stats nb_workers (fun () -> let all = let all = Util.StringMap.bindings all |> List.map snd in - Odoc_unit.of_packages ~output_dir:odoc_dir ~linked_dir:odocl_dir - ~index_dir:None all + let internal = + Odoc_unit.of_packages ~output_dir:odoc_dir ~linked_dir:odocl_dir + ~index_dir:None all + in + let external_ = + let mld_dir = odoc_dir in + let odocl_dir = Option.value odocl_dir ~default:odoc_dir in + Landing_pages.of_packages ~mld_dir ~odoc_dir ~odocl_dir + ~output_dir:odoc_dir all + in + internal @ external_ in Compile.init_stats all; let compiled = @@ -573,6 +582,11 @@ let run libs verbose packages_dir odoc_dir odocl_dir html_dir stats nb_workers (fun () -> render_stats env nb_workers) in + (* List.iter *) + (* (fun l -> *) + (* if Astring.String.is_infix ~affix:"index.mld" l then *) + (* Format.printf "%s\n" l) *) + (* !Cmd_outputs.compile_output; *) Format.eprintf "Final stats: %a@.%!" Stats.pp_stats Stats.stats; Format.eprintf "Total time: %f@.%!" (Stats.total_time ()); if stats then Stats.bench_results html_dir diff --git a/src/driver/odoc_unit.ml b/src/driver/odoc_unit.ml index 685dd5464e..74677c58fd 100644 --- a/src/driver/odoc_unit.ml +++ b/src/driver/odoc_unit.ml @@ -20,7 +20,7 @@ type 'a unit = { pkg_args : pkg_args; pkgname : string; include_dirs : Fpath.t list; - index : index; + index : index option; kind : 'a; } @@ -110,7 +110,7 @@ let of_packages ~output_dir ~linked_dir ~index_dir (pkgs : Packages.t list) : odocl_file; include_dirs; kind; - index = index_of pkg; + index = Some (index_of pkg); } in let rec build_deps deps = diff --git a/src/driver/odoc_unit.mli b/src/driver/odoc_unit.mli index be617ee12c..c99bd1627a 100644 --- a/src/driver/odoc_unit.mli +++ b/src/driver/odoc_unit.mli @@ -20,7 +20,7 @@ type 'a unit = { pkg_args : pkg_args; pkgname : string; include_dirs : Fpath.t list; - index : index; + index : index option; kind : 'a; } From f6a648d9658e7dd43ac705411d8f46d16becec82 Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Wed, 31 Jul 2024 12:00:44 +0200 Subject: [PATCH 2/9] Allow for empty --parent-id Useful for the list of packages landing page --- src/driver/landing_pages.ml | 14 ++++++++------ src/driver/odoc.ml | 35 ++++++++++++++++++++++------------ src/driver/odoc.mli | 18 ++++++++++-------- src/driver/odoc_driver.ml | 6 +++++- src/driver/odoc_unit.ml | 8 ++++---- src/driver/odoc_unit.mli | 4 ++-- src/html/link.ml | 8 +++++++- src/odoc/asset.ml | 14 +++++++++++--- src/odoc/asset.mli | 8 +++++++- src/odoc/bin/main.ml | 4 +++- src/odoc/compile.ml | 38 ++++++++++++++++++------------------- src/odoc/compile.mli | 5 +++-- src/odoc/source.ml | 8 +++++++- 13 files changed, 109 insertions(+), 61 deletions(-) diff --git a/src/driver/landing_pages.ml b/src/driver/landing_pages.ml index 32ea9db1c6..2bb8dbcfef 100644 --- a/src/driver/landing_pages.ml +++ b/src/driver/landing_pages.ml @@ -43,7 +43,9 @@ let list_packages_content all = all |> List.sort (fun n1 n2 -> String.compare n1.name n2.name) in let title = "{0 List of all packages}\n" in - let s_of_pkg pkg = Format.sprintf "- {{!/%s/index}%s}" pkg.name pkg.name in + let s_of_pkg pkg = + Format.sprintf "- {{!/__driver/%s/index}%s}" pkg.name pkg.name + in let pkg_ul = sorted_packages |> List.map s_of_pkg |> String.concat "\n" in title ^ pkg_ul @@ -55,7 +57,7 @@ let of_package ~mld_dir ~odoc_dir ~odocl_dir ~output_dir pkg = let odoc_file = Fpath.(odoc_dir // rel_path / "page-index.odoc") in let odocl_file = Fpath.(odocl_dir // rel_path / "page-index.odocl") in let () = write_file input_file content in - let parent_id = rel_path |> Odoc.id_of_fpath in + let parent_id = rel_path |> Odoc.Id.of_fpath in let open Odoc_unit in { parent_id; @@ -106,17 +108,17 @@ let of_package ~mld_dir ~odoc_dir ~odocl_dir ~output_dir pkg = let of_packages ~mld_dir ~odoc_dir ~odocl_dir ~output_dir all = let content = list_packages_content all in - let rel_path = Fpath.v "a" in + let rel_path = Fpath.v "./" in let input_file = Fpath.(mld_dir // rel_path / "index.mld") in let () = write_file input_file content in let open Odoc_unit in - let parent_id = rel_path |> Odoc.id_of_fpath in + let parent_id = rel_path |> Odoc.Id.of_fpath in let pkgname = "__driver" in let pkg_args = { pages = - (pkgname, Fpath.(odoc_dir // rel_path)) - :: List.map (fun pkg -> (pkg.name, Fpath.(odoc_dir / pkg.name))) all; + (pkgname, Fpath.(odoc_dir // rel_path)) :: [] + (* List.map (fun pkg -> (pkg.name, Fpath.(odoc_dir / pkg.name))) all *); libs = []; } in diff --git a/src/driver/odoc.ml b/src/driver/odoc.ml index aa5d9855e4..03edd03bc2 100644 --- a/src/driver/odoc.ml +++ b/src/driver/odoc.ml @@ -1,12 +1,20 @@ open Bos -type id = Fpath.t +module Id : sig + type t + val to_fpath : t -> Fpath.t + val of_fpath : Fpath.t -> t + val to_string : t -> string +end = struct + type t = Fpath.t -let fpath_of_id id = id + let to_fpath id = id -let id_of_fpath id = - id |> Fpath.normalize - |> Fpath.rem_empty_seg (* If an odoc path ends with a [/] everything breaks *) + let of_fpath id = id |> Fpath.normalize |> Fpath.rem_empty_seg + (* If an odoc path ends with a [/] everything breaks *) + + let to_string id = match Fpath.to_string id with "." -> "" | v -> v +end let index_filename = "index.odoc-index" @@ -33,13 +41,13 @@ let compile ~output_dir ~input_file:file ~includes ~parent_id = in let output_file = let _, f = Fpath.split_base file in - Some Fpath.(output_dir // parent_id // set_ext "odoc" f) + Some Fpath.(output_dir // Id.to_fpath parent_id // set_ext "odoc" f) in let cmd = !odoc % "compile" % Fpath.to_string file % "--output-dir" % p output_dir %% includes % "--enable-missing-root-warning" in - let cmd = cmd % "--parent-id" % Fpath.to_string parent_id in + let cmd = cmd % "--parent-id" % Id.to_string parent_id in let desc = Printf.sprintf "Compiling %s" (Fpath.to_string file) in let lines = Cmd_outputs.submit desc cmd output_file in Cmd_outputs.( @@ -48,13 +56,14 @@ let compile ~output_dir ~input_file:file ~includes ~parent_id = let compile_asset ~output_dir ~name ~parent_id = let open Cmd in let output_file = - Some Fpath.(output_dir // parent_id / ("asset-" ^ name ^ ".odoc")) + Some + Fpath.(output_dir // Id.to_fpath parent_id / ("asset-" ^ name ^ ".odoc")) in let cmd = !odoc % "compile-asset" % "--name" % name % "--output-dir" % p output_dir in - let cmd = cmd % "--parent-id" % Fpath.to_string parent_id in + let cmd = cmd % "--parent-id" % Id.to_string parent_id in let desc = Printf.sprintf "Compiling %s" name in let lines = Cmd_outputs.submit desc cmd output_file in Cmd_outputs.(add_prefixed_output cmd compile_output name lines) @@ -73,10 +82,12 @@ let compile_impl ~output_dir ~input_file:file ~includes ~parent_id ~source_id = let output_file = let _, f = Fpath.split_base file in Some - Fpath.(output_dir // parent_id / ("impl-" ^ to_string (set_ext "odoc" f))) + Fpath.( + output_dir // Id.to_fpath parent_id + / ("impl-" ^ to_string (set_ext "odoc" f))) in - let cmd = cmd % "--parent-id" % Fpath.to_string parent_id in - let cmd = cmd % "--source-id" % Fpath.to_string source_id in + let cmd = cmd % "--parent-id" % Id.to_string parent_id in + let cmd = cmd % "--source-id" % Id.to_string source_id in let desc = Printf.sprintf "Compiling implementation %s" (Fpath.to_string file) in diff --git a/src/driver/odoc.mli b/src/driver/odoc.mli index 06ae01fcf3..6c45f940b6 100644 --- a/src/driver/odoc.mli +++ b/src/driver/odoc.mli @@ -1,7 +1,9 @@ -type id - -val fpath_of_id : id -> Fpath.t -val id_of_fpath : Fpath.t -> id +module Id : sig + type t + val to_fpath : t -> Fpath.t + val of_fpath : Fpath.t -> t + val to_string : t -> string +end val index_filename : string @@ -14,17 +16,17 @@ val compile_impl : output_dir:Fpath.t -> input_file:Fpath.t -> includes:Fpath.set -> - parent_id:id -> - source_id:id -> + parent_id:Id.t -> + source_id:Id.t -> unit val compile : output_dir:Fpath.t -> input_file:Fpath.t -> includes:Fpath.set -> - parent_id:id -> + parent_id:Id.t -> unit -val compile_asset : output_dir:Fpath.t -> name:string -> parent_id:id -> unit +val compile_asset : output_dir:Fpath.t -> name:string -> parent_id:Id.t -> unit val link : ?ignore_output:bool -> diff --git a/src/driver/odoc_driver.ml b/src/driver/odoc_driver.ml index 1158055292..5cdb51f958 100644 --- a/src/driver/odoc_driver.ml +++ b/src/driver/odoc_driver.ml @@ -584,9 +584,13 @@ let run libs verbose packages_dir odoc_dir odocl_dir html_dir stats nb_workers (* List.iter *) (* (fun l -> *) - (* if Astring.String.is_infix ~affix:"index.mld" l then *) + (* if Astring.String.is_infix ~affix:"_odoc/./index.mld" l then *) (* Format.printf "%s\n" l) *) (* !Cmd_outputs.compile_output; *) + (* List.iter *) + (* (fun l -> *) + (* if Astring.String.is_infix ~affix:"__driver" l then Format.printf "%s\n" l) *) + (* !Cmd_outputs.link_output; *) Format.eprintf "Final stats: %a@.%!" Stats.pp_stats Stats.stats; Format.eprintf "Total time: %f@.%!" (Stats.total_time ()); if stats then Stats.bench_results html_dir diff --git a/src/driver/odoc_unit.ml b/src/driver/odoc_unit.ml index 74677c58fd..66812f22b0 100644 --- a/src/driver/odoc_unit.ml +++ b/src/driver/odoc_unit.ml @@ -11,7 +11,7 @@ type index = { } type 'a unit = { - parent_id : Odoc.id; + parent_id : Odoc.Id.t; odoc_dir : Fpath.t; input_file : Fpath.t; output_dir : Fpath.t; @@ -27,7 +27,7 @@ type 'a unit = { type intf_extra = { hidden : bool; hash : string; deps : intf unit list } and intf = [ `Intf of intf_extra ] -type impl_extra = { src_id : Odoc.id; src_path : Fpath.t } +type impl_extra = { src_id : Odoc.Id.t; src_path : Fpath.t } type impl = [ `Impl of impl_extra ] type mld = [ `Mld ] @@ -96,7 +96,7 @@ let of_packages ~output_dir ~linked_dir ~index_dir (pkgs : Packages.t list) : let ( // ) = Fpath.( // ) in let ( / ) = Fpath.( / ) in let odoc_dir = output_dir // rel_dir in - let parent_id = rel_dir |> Odoc.id_of_fpath in + let parent_id = rel_dir |> Odoc.Id.of_fpath in let odoc_file = odoc_dir / (name ^ ".odoc") in let odocl_file = linked_dir // rel_dir / (name ^ ".odocl") in { @@ -152,7 +152,7 @@ let of_packages ~output_dir ~linked_dir ~index_dir (pkgs : Packages.t list) : let kind = let src_name = Fpath.filename src_path in let src_id = - Fpath.(pkg.pkg_dir / "src" / libname / src_name) |> Odoc.id_of_fpath + Fpath.(pkg.pkg_dir / "src" / libname / src_name) |> Odoc.Id.of_fpath in `Impl { src_id; src_path } in diff --git a/src/driver/odoc_unit.mli b/src/driver/odoc_unit.mli index c99bd1627a..9da8701704 100644 --- a/src/driver/odoc_unit.mli +++ b/src/driver/odoc_unit.mli @@ -11,7 +11,7 @@ type index = { } type 'a unit = { - parent_id : Odoc.id; + parent_id : Odoc.Id.t; odoc_dir : Fpath.t; input_file : Fpath.t; output_dir : Fpath.t; @@ -27,7 +27,7 @@ type 'a unit = { type intf_extra = { hidden : bool; hash : string; deps : intf unit list } and intf = [ `Intf of intf_extra ] -type impl_extra = { src_id : Odoc.id; src_path : Fpath.t } +type impl_extra = { src_id : Odoc.Id.t; src_path : Fpath.t } type impl = [ `Impl of impl_extra ] type mld = [ `Mld ] diff --git a/src/html/link.ml b/src/html/link.ml index ece4b8c001..da2b2b1534 100644 --- a/src/html/link.ml +++ b/src/html/link.ml @@ -36,7 +36,13 @@ module Path = struct dir @ [ file ] let as_filename ~is_flat (url : Url.Path.t) = - Fpath.(v @@ String.concat Fpath.dir_sep @@ for_linking ~is_flat url) + let url_segs = for_linking ~is_flat url in + let filename = + match url_segs with + | [] -> Fpath.v "./" + | url_segs -> Fpath.(v @@ String.concat Fpath.dir_sep @@ url_segs) + in + filename end type resolve = Current of Url.Path.t | Base of string diff --git a/src/odoc/asset.ml b/src/odoc/asset.ml index e38c1067f4..21f8d85405 100644 --- a/src/odoc/asset.ml +++ b/src/odoc/asset.ml @@ -1,12 +1,20 @@ +open Or_error + let compile ~parent_id ~name ~output_dir = let open Odoc_model in - let parent_id = Compile.mk_id parent_id in + let parent_id = + match Compile.mk_id parent_id with + | Some s -> Ok s + | None -> + Error (`Msg "parent-id cannot be empty when compiling implementations.") + in + parent_id >>= fun parent_id -> let id = Paths.Identifier.Mk.asset_file ((parent_id :> Paths.Identifier.Page.t), Names.AssetName.make_std name) in let directory = - Compile.path_of_id output_dir parent_id + Compile.path_of_id output_dir (Some parent_id) |> Fpath.to_string |> Fs.Directory.of_string in let name = "asset-" ^ name ^ ".odoc" in @@ -21,4 +29,4 @@ let compile ~parent_id ~name ~output_dir = } in let asset = Lang.Asset.{ name = id; root } in - Odoc_file.save_asset output ~warnings:[] asset + Ok (Odoc_file.save_asset output ~warnings:[] asset) diff --git a/src/odoc/asset.mli b/src/odoc/asset.mli index 157cbbcea8..8ac413ec54 100644 --- a/src/odoc/asset.mli +++ b/src/odoc/asset.mli @@ -1 +1,7 @@ -val compile : parent_id:string -> name:string -> output_dir:string -> unit +open Or_error + +val compile : + parent_id:string -> + name:string -> + output_dir:string -> + (unit, [> msg ]) result diff --git a/src/odoc/bin/main.ml b/src/odoc/bin/main.ml index bc8ccccd81..8829f2efdd 100644 --- a/src/odoc/bin/main.ml +++ b/src/odoc/bin/main.ml @@ -353,7 +353,9 @@ module Compile_asset = struct & opt (some string) None & info ~docs ~docv:"PARENT" ~doc [ "parent-id" ]) in - Term.(const compile_asset $ parent_id $ asset_name $ output_dir) + Term.( + const handle_error + $ (const compile_asset $ parent_id $ asset_name $ output_dir)) let info ~docs = let man = diff --git a/src/odoc/compile.ml b/src/odoc/compile.ml index 09e59a68aa..26964733da 100644 --- a/src/odoc/compile.ml +++ b/src/odoc/compile.ml @@ -42,11 +42,13 @@ type spec = { } let rec path_of_id output_dir id = - match (id : Paths.Identifier.ContainerPage.t).iv with - | `Page (None, p) -> Fpath.(v output_dir / PageName.to_string p) - | `Page (Some parent, p) -> - let d = path_of_id output_dir parent in - Fpath.(d / PageName.to_string p) + match id with + | None -> Fpath.v output_dir + | Some id -> ( + match (id : Paths.Identifier.ContainerPage.t).iv with + | `Page (parent, p) -> + let d = path_of_id output_dir parent in + Fpath.(d / PageName.to_string p)) let check_is_empty msg = function [] -> Ok () | _ :: _ -> Error (`Msg msg) @@ -95,13 +97,17 @@ let resolve_parent_page resolver f = extract_parent page.name >>= fun parent -> Ok (parent, page.children) let mk_id str = - let l = String.cuts ~sep:"/" str in - List.fold_left - (fun acc id -> Some (Paths.Identifier.Mk.page (acc, PageName.make_std id))) - None l - |> function - | Some x -> x - | None -> failwith "Failed to create ID" + match str with + | "" -> None + | str -> ( + let l = String.cuts ~sep:"/" str in + List.fold_left + (fun acc id -> + Some (Paths.Identifier.Mk.page (acc, PageName.make_std id))) + None l + |> function + | Some x -> Some x + | None -> failwith "Failed to create ID") let resolve_imports resolver imports = List.map @@ -300,13 +306,7 @@ let resolve_spec ~input resolver cli_spec = else name |> Fpath.to_string |> String.Ascii.uncapitalize in let output = Fs.File.create ~directory ~name in - Ok - { - parent_id = Some parent_id; - output; - parents_children = None; - children = []; - } + Ok { parent_id; output; parents_children = None; children = [] } | CliNoParent output -> Ok { output; parent_id = None; parents_children = None; children = [] } diff --git a/src/odoc/compile.mli b/src/odoc/compile.mli index dfa17159b0..4a82262e39 100644 --- a/src/odoc/compile.mli +++ b/src/odoc/compile.mli @@ -49,8 +49,9 @@ val resolve_parent_page : (** Parse and resolve a parent reference. Returns the identifier of the parent and its children as a list of reference. *) -val mk_id : string -> Identifier.ContainerPage.t -val path_of_id : string -> Comment.Identifier.Id.container_page -> Fpath.t +val mk_id : string -> Identifier.ContainerPage.t option +val path_of_id : + string -> Comment.Identifier.Id.container_page option -> Fpath.t val compile : resolver:Resolver.t -> diff --git a/src/odoc/source.ml b/src/odoc/source.ml index e2acb2c4ba..cd6ba6d35c 100644 --- a/src/odoc/source.ml +++ b/src/odoc/source.ml @@ -31,8 +31,14 @@ let compile ~resolver ~output ~warnings_options ~source_id input = Error (`Msg "Source id cannot be in the root directory") else let parent = - Compile.mk_id Fpath.(to_string (rem_empty_seg parent_id)) + match Compile.mk_id Fpath.(to_string (rem_empty_seg parent_id)) with + | Some s -> Ok s + | None -> + Error + (`Msg + "parent-id cannot be empty when compiling implementations.") in + parent >>= fun parent -> let source_id = Paths.Identifier.Mk.source_page (parent, Fpath.to_string name) in From f73370256ee99b2624749d6e256b11ae3725b829 Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Wed, 31 Jul 2024 15:59:18 +0200 Subject: [PATCH 3/9] Driver: refactor `Landing_page` module --- src/driver/landing_pages.ml | 349 ++++++++++++----------------------- src/driver/landing_pages.mli | 7 + 2 files changed, 123 insertions(+), 233 deletions(-) create mode 100644 src/driver/landing_pages.mli diff --git a/src/driver/landing_pages.ml b/src/driver/landing_pages.ml index 2bb8dbcfef..b4165ce42b 100644 --- a/src/driver/landing_pages.ml +++ b/src/driver/landing_pages.ml @@ -1,254 +1,137 @@ open Packages - -let pkg_landing_page_content pkg = - let title = Format.sprintf "{0 %s}\n" pkg.name in - let documentation = - match pkg.mlds with - | _ :: _ -> - Format.sprintf - "{1 Documentation pages}\n\n{{!/%s/doc/index}Documentation for %s}\n" - pkg.name pkg.name - | [] -> "" - in - let libraries = - match pkg.libraries with - | [] -> "" - | _ :: _ -> - Format.sprintf "{1 Libraries}\n\n{{!/%s/lib/index}Libraries for %s}\n" - pkg.name pkg.name - in - title ^ documentation ^ libraries - -let library_landing_page_content lib = - let title = Format.sprintf "{0 %s}\n" lib.lib_name in - let s_of_module m = - if m.m_hidden then None - else Some (Format.sprintf "- {!%s}" m.Packages.m_name) - in - let modules = - lib.modules |> List.filter_map s_of_module |> String.concat "\n" - in - title ^ modules - -let libraries_landing_page_content pkg = - let title = Format.sprintf "{0 %s}\n" pkg.name in - let s_of_lib (lib : Packages.libty) = - Format.sprintf "- {{!/%s/%s/index}%s}" pkg.name lib.lib_name lib.lib_name - in - let libraries = pkg.libraries |> List.map s_of_lib |> String.concat "\n" in - title ^ libraries - -let list_packages_content all = - let sorted_packages = - all |> List.sort (fun n1 n2 -> String.compare n1.name n2.name) - in - let title = "{0 List of all packages}\n" in - let s_of_pkg pkg = - Format.sprintf "- {{!/__driver/%s/index}%s}" pkg.name pkg.name - in - let pkg_ul = sorted_packages |> List.map s_of_pkg |> String.concat "\n" in - title ^ pkg_ul - +open Odoc_unit let write_file file content = Bos.OS.File.write file content |> Result.get_ok -let of_package ~mld_dir ~odoc_dir ~odocl_dir ~output_dir pkg = - let make_unit rel_path ~content ?(include_dirs = []) ~pkgname ~pkg_args () = - let input_file = Fpath.(mld_dir // rel_path / "index.mld") in - let odoc_file = Fpath.(odoc_dir // rel_path / "page-index.odoc") in - let odocl_file = Fpath.(odocl_dir // rel_path / "page-index.odocl") in - let () = write_file input_file content in - let parent_id = rel_path |> Odoc.Id.of_fpath in - let open Odoc_unit in - { - parent_id; - odoc_dir; - input_file; - output_dir; - odoc_file; - odocl_file; - pkg_args; - pkgname; - include_dirs; - index = None; - kind = `Mld; - } - in - let library_list_page = - let open Odoc_unit in - let content = libraries_landing_page_content pkg in - let rel_path = Fpath.(v pkg.name / "lib") in - let pkg_args = - { pages = [ (pkg.name, Fpath.( // ) odoc_dir rel_path) ]; libs = [] } - in - make_unit rel_path ~content ~pkgname:pkg.name ~pkg_args () - in - let library_landing_pages = - let do_ lib = - let open Odoc_unit in - let content = library_landing_page_content lib in - let rel_path = Fpath.(v pkg.name / "lib" / lib.lib_name) in - let pkg_args = - { pages = [ (pkg.name, Fpath.( // ) odoc_dir rel_path) ]; libs = [] } - in - let include_dirs = [ Fpath.(odoc_dir // rel_path) ] in - make_unit rel_path ~content ~pkgname:pkg.name ~include_dirs ~pkg_args () - in - List.map do_ pkg.libraries - in - let package_landing_page = - let open Odoc_unit in - let content = pkg_landing_page_content pkg in - let rel_path = Fpath.v pkg.name in - let pkg_args = - { pages = [ (pkg.name, Fpath.( // ) odoc_dir rel_path) ]; libs = [] } - in - make_unit rel_path ~content ~pkgname:pkg.name ~pkg_args () - in - package_landing_page :: library_list_page :: library_landing_pages - -let of_packages ~mld_dir ~odoc_dir ~odocl_dir ~output_dir all = - let content = list_packages_content all in - let rel_path = Fpath.v "./" in +let make_unit ~odoc_dir ~odocl_dir ~mld_dir ~output_dir rel_path ~content + ?(include_dirs = []) ~pkgname ~pkg_args () = let input_file = Fpath.(mld_dir // rel_path / "index.mld") in + let odoc_file = Fpath.(odoc_dir // rel_path / "page-index.odoc") in + let odocl_file = Fpath.(odocl_dir // rel_path / "page-index.odocl") in let () = write_file input_file content in - let open Odoc_unit in let parent_id = rel_path |> Odoc.Id.of_fpath in - let pkgname = "__driver" in - let pkg_args = - { - pages = - (pkgname, Fpath.(odoc_dir // rel_path)) :: [] - (* List.map (fun pkg -> (pkg.name, Fpath.(odoc_dir / pkg.name))) all *); - libs = []; - } - in { parent_id; odoc_dir; input_file; output_dir; + odoc_file; + odocl_file; pkg_args; pkgname; - odoc_file = Fpath.(odoc_dir // rel_path / "page-index.odoc"); - odocl_file = Fpath.(odocl_dir // rel_path / "page-index.odocl"); - include_dirs = []; + include_dirs; index = None; kind = `Mld; } - :: List.concat_map (of_package ~mld_dir ~odoc_dir ~odocl_dir ~output_dir) all -(* let compile_list_packages odoc_dir all : compiled = *) -(* let sorted_packages = *) -(* all |> Util.StringMap.to_list *) -(* |> List.sort (fun (n1, _) (n2, _) -> String.compare n1 n2) *) -(* in *) -(* let title = "{0 List of all packages}\n" in *) -(* let s_of_pkg (name, _) = Format.sprintf "- {{!%s/index}%s}" name name in *) -(* let pkg_ul = sorted_packages |> List.map s_of_pkg |> String.concat "\n" in *) -(* let content = title ^ pkg_ul in *) -(* let input_file = Fpath.( / ) odoc_dir "index.mld" in *) -(* let () = Bos.OS.File.write input_file content |> Result.get_ok in *) -(* Odoc.compile ~output_dir:odoc_dir ~input_file ~includes:Fpath.Set.empty *) -(* ~parent_id:(Odoc.id_of_fpath (Fpath.v "./")); *) -(* Atomic.incr Stats.stats.compiled_mlds; *) -(* { *) -(* m = Mld; *) -(* odoc_output_dir = odoc_dir; *) -(* odoc_file = Fpath.(odoc_dir / "page-index.odoc"); *) -(* odocl_file = Fpath.(odoc_dir / "page-index.odocl"); *) -(* include_dirs = Fpath.Set.empty; *) -(* impl = None; *) -(* pkg_args = { docs = [ ("_driver_pkg", odoc_dir) ]; libs = [] }; *) -(* pkgname = { p_name = "_driver_pkg"; p_dir = Fpath.v "./" }; *) -(* } *) +module PackageLanding = struct + let content pkg = + let title = Format.sprintf "{0 %s}\n" pkg.name in + let documentation = + match pkg.mlds with + | _ :: _ -> + Format.sprintf + "{1 Documentation pages}\n\n\ + {{!/%s/doc/index}Documentation for %s}\n" + pkg.name pkg.name + | [] -> "" + in + let libraries = + match pkg.libraries with + | [] -> "" + | _ :: _ -> + Format.sprintf "{1 Libraries}\n\n{{!/%s/lib/index}Libraries for %s}\n" + pkg.name pkg.name + in + title ^ documentation ^ libraries + + let page ~odoc_dir ~odocl_dir ~mld_dir ~output_dir ~pkg = + let content = content pkg in + let rel_path = Fpath.v pkg.name in + let pkg_args = + { pages = [ (pkg.name, Fpath.( // ) odoc_dir rel_path) ]; libs = [] } + in + make_unit ~odoc_dir ~odocl_dir ~mld_dir ~output_dir rel_path ~content + ~pkgname:pkg.name ~pkg_args () +end + +module PackageList = struct + let content all = + let sorted_packages = + all |> List.sort (fun n1 n2 -> String.compare n1.name n2.name) + in + let title = "{0 List of all packages}\n" in + let s_of_pkg pkg = + Format.sprintf "- {{!/__driver/%s/index}%s}" pkg.name pkg.name + in + let pkg_ul = sorted_packages |> List.map s_of_pkg |> String.concat "\n" in + title ^ pkg_ul + + let page ~mld_dir ~odoc_dir ~odocl_dir ~output_dir all = + let content = content all in + let rel_path = Fpath.v "./" in + let pkgname = "__driver" in + let pkg_args = + { pages = [ (pkgname, Fpath.(odoc_dir // rel_path)) ]; libs = [] } + in + make_unit ~odoc_dir ~odocl_dir ~mld_dir ~output_dir ~content ~pkgname + ~pkg_args rel_path () +end + +module LibraryLanding = struct + let content lib = + let title = Format.sprintf "{0 %s}\n" lib.lib_name in + let s_of_module m = + if m.m_hidden then None + else Some (Format.sprintf "- {!%s}" m.Packages.m_name) + in + let modules = + lib.modules |> List.filter_map s_of_module |> String.concat "\n" + in + title ^ modules + let page ~pkg ~odoc_dir ~odocl_dir ~mld_dir ~output_dir lib = + let content = content lib in + let rel_path = Fpath.(v pkg.name / "lib" / lib.lib_name) in + let pkg_args = + { pages = [ (pkg.name, Fpath.( // ) odoc_dir rel_path) ]; libs = [] } + in + let include_dirs = [ Fpath.(odoc_dir // rel_path) ] in + make_unit ~odoc_dir ~odocl_dir ~mld_dir ~output_dir rel_path ~content + ~pkgname:pkg.name ~include_dirs ~pkg_args () +end -(* let compile_landing_pages odoc_dir pkg : compiled list = *) -(* let pkgname = pkg.Packages.pkgname in *) -(* let driver_page ~odoc_file ~odocl_file ?(include_dirs = Fpath.Set.empty) () = *) -(* let pkg_args = *) -(* { *) -(* docs = [ (pkgname.p_name, Fpath.( / ) odoc_dir pkgname.p_name) ]; *) -(* libs = []; *) -(* } *) -(* in *) -(* { *) -(* m = Mld; *) -(* odoc_output_dir = odoc_dir; *) -(* odoc_file; *) -(* odocl_file; *) -(* include_dirs; *) -(* impl = None; *) -(* pkg_args; *) -(* pkgname; *) -(* } *) -(* in *) -(* let title = Format.sprintf "{0 %s}\n" in *) -(* let compile ~content ~input_file ?(include_dirs = Fpath.Set.empty) ~parent_id *) -(* () = *) -(* let () = Bos.OS.File.write input_file content |> Result.get_ok in *) -(* Odoc.compile ~output_dir:odoc_dir ~input_file ~includes:include_dirs *) -(* ~parent_id; *) -(* Atomic.incr Stats.stats.compiled_mlds; *) -(* ( Fpath.(odoc_dir // Odoc.fpath_of_id parent_id / "page-index.odoc"), *) -(* Fpath.(odoc_dir // Odoc.fpath_of_id parent_id / "page-index.odocl") ) *) -(* in *) +module PackageLibLanding = struct + let content pkg = + let title = Format.sprintf "{0 %s}\n" pkg.name in + let s_of_lib (lib : Packages.libty) = + Format.sprintf "- {{!/%s/%s/index}%s}" pkg.name lib.lib_name lib.lib_name + in + let libraries = pkg.libraries |> List.map s_of_lib |> String.concat "\n" in + title ^ libraries -(* let library_landing_page pkgname (lib : Packages.libty) : compiled = *) -(* let libname = lib.lib_name in *) -(* let parent_id = *) -(* Fpath.(v pkgname.Packages.p_name / "lib" / libname) |> Odoc.id_of_fpath *) -(* in *) -(* let input_file = *) -(* Fpath.(odoc_dir // Odoc.fpath_of_id parent_id / "index.mld") *) -(* in *) -(* let s_of_module m = Format.sprintf "- {!%s}" m.Packages.m_name in *) -(* let modules = lib.modules |> List.map s_of_module |> String.concat "\n" in *) -(* let content = title libname ^ modules in *) -(* let include_dirs = *) -(* Fpath.(Set.empty |> Set.add (odoc_dir // Odoc.fpath_of_id parent_id)) *) -(* in *) -(* let odoc_file, odocl_file = *) -(* compile ~content ~input_file ~include_dirs ~parent_id () *) -(* in *) -(* driver_page ~odoc_file ~odocl_file ~include_dirs () *) -(* in *) + let page ~pkg ~odoc_dir ~odocl_dir ~mld_dir ~output_dir = + let content = content pkg in + let rel_path = Fpath.(v pkg.name / "lib") in + let pkg_args = + { pages = [ (pkg.name, Fpath.( // ) odoc_dir rel_path) ]; libs = [] } + in + make_unit ~odoc_dir ~odocl_dir ~mld_dir ~output_dir rel_path ~content + ~pkgname:pkg.name ~pkg_args () +end -(* let libraries_landing_page pkg : compiled list = *) -(* let pkgname = pkg.Packages.pkgname in *) -(* let parent_id = Fpath.(v pkgname.p_name / "lib") |> Odoc.id_of_fpath in *) -(* let input_file = *) -(* Fpath.(odoc_dir // Odoc.fpath_of_id parent_id / "index.mld") *) -(* in *) -(* let s_of_lib (lib : Packages.libty) = *) -(* Format.sprintf "- {{!%s/index}%s}" lib.lib_name lib.lib_name *) -(* in *) -(* let libraries = pkg.libraries |> List.map s_of_lib |> String.concat "\n" in *) -(* let content = title pkgname.p_name ^ libraries in *) -(* let odoc_file, odocl_file = compile ~content ~input_file ~parent_id () in *) -(* driver_page ~odoc_file ~odocl_file () *) -(* :: List.map (library_landing_page pkgname) pkg.libraries *) -(* in *) +let of_package ~mld_dir ~odoc_dir ~odocl_dir ~output_dir pkg = + let library_pages = + List.map + (LibraryLanding.page ~pkg ~odoc_dir ~odocl_dir ~mld_dir ~output_dir) + pkg.libraries + in + let package_landing_page = + PackageLanding.page ~odoc_dir ~odocl_dir ~mld_dir ~output_dir ~pkg + in + let library_list_page = + PackageLibLanding.page ~odoc_dir ~odocl_dir ~mld_dir ~output_dir ~pkg + in + package_landing_page :: library_list_page :: library_pages -(* let package_landing_page = *) -(* let input_file = Fpath.(odoc_dir // v pkgname.p_name / "index.mld") in *) -(* let documentation = *) -(* match pkg.mlds with *) -(* | _ :: _ -> *) -(* Format.sprintf *) -(* "{1 Documentation pages}\n\n{{!doc/index}Documentation for %s}" *) -(* pkgname.p_name *) -(* | [] -> "" *) -(* in *) -(* let libraries = *) -(* match pkg.libraries with *) -(* | [] -> "" *) -(* | _ :: _ -> *) -(* Format.sprintf "{1 Libraries}\n\n{{!lib/index}Libraries for %s}" *) -(* pkgname.p_name *) -(* in *) -(* let content = title pkgname.p_name ^ documentation ^ libraries in *) -(* let parent_id = Odoc.id_of_fpath (Fpath.v pkgname.p_name) in *) -(* let odoc_file, odocl_file = compile ~content ~input_file ~parent_id () in *) -(* driver_page ~odoc_file ~odocl_file () *) -(* in *) -(* package_landing_page :: libraries_landing_page pkg *) +let of_packages ~mld_dir ~odoc_dir ~odocl_dir ~output_dir all = + PackageList.page ~mld_dir ~odoc_dir ~odocl_dir ~output_dir all + :: List.concat_map (of_package ~mld_dir ~odoc_dir ~odocl_dir ~output_dir) all diff --git a/src/driver/landing_pages.mli b/src/driver/landing_pages.mli new file mode 100644 index 0000000000..ee44cf1880 --- /dev/null +++ b/src/driver/landing_pages.mli @@ -0,0 +1,7 @@ +val of_packages : + mld_dir:Fpath.t -> + odoc_dir:Fpath.t -> + odocl_dir:Fpath.t -> + output_dir:Fpath.t -> + Packages.t list -> + [> `Mld ] Odoc_unit.unit list From df0971ecedbc2062d65eb06689ea819be0679b2c Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Tue, 20 Aug 2024 16:25:01 +0200 Subject: [PATCH 4/9] Driver: create directory if needed --- src/driver/landing_pages.ml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/driver/landing_pages.ml b/src/driver/landing_pages.ml index b4165ce42b..8fa375d87f 100644 --- a/src/driver/landing_pages.ml +++ b/src/driver/landing_pages.ml @@ -1,13 +1,12 @@ open Packages open Odoc_unit -let write_file file content = Bos.OS.File.write file content |> Result.get_ok let make_unit ~odoc_dir ~odocl_dir ~mld_dir ~output_dir rel_path ~content ?(include_dirs = []) ~pkgname ~pkg_args () = let input_file = Fpath.(mld_dir // rel_path / "index.mld") in let odoc_file = Fpath.(odoc_dir // rel_path / "page-index.odoc") in let odocl_file = Fpath.(odocl_dir // rel_path / "page-index.odocl") in - let () = write_file input_file content in + let () = Util.write_file input_file (String.split_on_char '\n' content) in let parent_id = rel_path |> Odoc.Id.of_fpath in { parent_id; From f0c50e191d9c697316ebc06aa65a7af77dec527c Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Tue, 20 Aug 2024 16:25:16 +0200 Subject: [PATCH 5/9] Driver: cleanup unnecessary changes --- src/driver/odoc_driver.ml | 9 --------- src/html/link.ml | 6 +----- 2 files changed, 1 insertion(+), 14 deletions(-) diff --git a/src/driver/odoc_driver.ml b/src/driver/odoc_driver.ml index 5cdb51f958..43738d265c 100644 --- a/src/driver/odoc_driver.ml +++ b/src/driver/odoc_driver.ml @@ -582,15 +582,6 @@ let run libs verbose packages_dir odoc_dir odocl_dir html_dir stats nb_workers (fun () -> render_stats env nb_workers) in - (* List.iter *) - (* (fun l -> *) - (* if Astring.String.is_infix ~affix:"_odoc/./index.mld" l then *) - (* Format.printf "%s\n" l) *) - (* !Cmd_outputs.compile_output; *) - (* List.iter *) - (* (fun l -> *) - (* if Astring.String.is_infix ~affix:"__driver" l then Format.printf "%s\n" l) *) - (* !Cmd_outputs.link_output; *) Format.eprintf "Final stats: %a@.%!" Stats.pp_stats Stats.stats; Format.eprintf "Total time: %f@.%!" (Stats.total_time ()); if stats then Stats.bench_results html_dir diff --git a/src/html/link.ml b/src/html/link.ml index da2b2b1534..871bcc12df 100644 --- a/src/html/link.ml +++ b/src/html/link.ml @@ -37,11 +37,7 @@ module Path = struct let as_filename ~is_flat (url : Url.Path.t) = let url_segs = for_linking ~is_flat url in - let filename = - match url_segs with - | [] -> Fpath.v "./" - | url_segs -> Fpath.(v @@ String.concat Fpath.dir_sep @@ url_segs) - in + let filename = Fpath.(v @@ String.concat Fpath.dir_sep @@ url_segs) in filename end From 31b6f5befa5ff9ee1ce1016231bc2506002e3ad7 Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Wed, 21 Aug 2024 13:38:16 +0200 Subject: [PATCH 6/9] Test: cover empty parent id --- test/parent_id/dune | 7 ++++++- test/parent_id/empty_parent_id.t/run.t | 15 +++++++++++++++ 2 files changed, 21 insertions(+), 1 deletion(-) create mode 100644 test/parent_id/empty_parent_id.t/run.t diff --git a/test/parent_id/dune b/test/parent_id/dune index 36d06be450..3d43ccd34c 100644 --- a/test/parent_id/dune +++ b/test/parent_id/dune @@ -1,2 +1,7 @@ +(env + (_ + (binaries + (../odoc_print/odoc_print.exe as odoc_print)))) + (cram - (deps %{bin:odoc})) + (deps %{bin:odoc} %{bin:odoc_print})) diff --git a/test/parent_id/empty_parent_id.t/run.t b/test/parent_id/empty_parent_id.t/run.t new file mode 100644 index 0000000000..deaf1a95cd --- /dev/null +++ b/test/parent_id/empty_parent_id.t/run.t @@ -0,0 +1,15 @@ + $ echo "{0 Test}" > file.mld + +It is possible to have pages with no parent, even with the odoc 3 "parent-id" +argument. In this case, an empty string is passed as argument. + + $ odoc compile --parent-id "" --output-dir _odoc file.mld + $ ls _odoc + page-file.odoc + $ odoc_print _odoc/page-file.odoc | jq ".name" + { + "`LeafPage": [ + "None", + "file" + ] + } From 773e5fd865d05aeadc6a858b06bae16b2baeda66 Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Wed, 21 Aug 2024 16:42:02 +0200 Subject: [PATCH 7/9] driver: Refactor Landing_pages to use Format Util.write_file is refactored to be more suitable. Co-authored-by: Paul-Elliot --- src/driver/compile.ml | 11 +++--- src/driver/dune | 3 +- src/driver/landing_pages.ml | 71 ++++++++++++++++--------------------- src/driver/util.ml | 37 +++++++------------ 4 files changed, 51 insertions(+), 71 deletions(-) diff --git a/src/driver/compile.ml b/src/driver/compile.ml index 1f66f23912..6b6525dddd 100644 --- a/src/driver/compile.ml +++ b/src/driver/compile.ml @@ -1,5 +1,7 @@ (* compile *) +open Bos + type compiled = Odoc_unit.t let mk_byhash (pkgs : Odoc_unit.t list) = @@ -58,8 +60,7 @@ let unmarshal filename : partial = (fun () -> Marshal.from_channel ic) let marshal (v : partial) filename = - let p = Fpath.parent filename in - Util.mkdir_p p; + let _ = OS.Dir.create (Fpath.parent filename) |> Result.get_ok in let oc = open_out_bin (Fpath.to_string filename) in Fun.protect ~finally:(fun () -> close_out oc) @@ -69,10 +70,10 @@ let find_partials odoc_dir : Odoc_unit.intf Odoc_unit.unit Util.StringMap.t * _ = let tbl = Hashtbl.create 1000 in let hashes_result = - Bos.OS.Dir.fold_contents ~dotfiles:false ~elements:`Dirs + OS.Dir.fold_contents ~dotfiles:false ~elements:`Dirs (fun p hashes -> let index_m = Fpath.( / ) p "index.m" in - match Bos.OS.File.exists index_m with + match OS.File.exists index_m with | Ok true -> let tbl', hashes' = unmarshal index_m in List.iter @@ -220,7 +221,7 @@ let sherlodoc_index_one ~output_dir (index : Odoc_unit.index) = let rel_path = Fpath.(index.search_dir / "sherlodoc_db.js") in let dst = Fpath.(output_dir // rel_path) in let dst_dir, _ = Fpath.split_base dst in - Util.mkdir_p dst_dir; + let _ = OS.Dir.create dst_dir |> Result.get_ok in Sherlodoc.index ~format:`js ~inputs ~dst (); rel_path diff --git a/src/driver/dune b/src/driver/dune index 2f861500b2..b65a7f2a62 100644 --- a/src/driver/dune +++ b/src/driver/dune @@ -13,4 +13,5 @@ opam-format logs logs.fmt - eio_main)) + eio_main + odoc_utils)) diff --git a/src/driver/landing_pages.ml b/src/driver/landing_pages.ml index 8fa375d87f..eca5d59aa2 100644 --- a/src/driver/landing_pages.ml +++ b/src/driver/landing_pages.ml @@ -1,12 +1,16 @@ open Packages open Odoc_unit +let fpf = Format.fprintf + let make_unit ~odoc_dir ~odocl_dir ~mld_dir ~output_dir rel_path ~content ?(include_dirs = []) ~pkgname ~pkg_args () = let input_file = Fpath.(mld_dir // rel_path / "index.mld") in let odoc_file = Fpath.(odoc_dir // rel_path / "page-index.odoc") in let odocl_file = Fpath.(odocl_dir // rel_path / "page-index.odocl") in - let () = Util.write_file input_file (String.split_on_char '\n' content) in + Util.with_out_to input_file (fun oc -> + fpf (Format.formatter_of_out_channel oc) "%t@?" content) + |> Result.get_ok; let parent_id = rel_path |> Odoc.Id.of_fpath in { parent_id; @@ -23,25 +27,15 @@ let make_unit ~odoc_dir ~odocl_dir ~mld_dir ~output_dir rel_path ~content } module PackageLanding = struct - let content pkg = - let title = Format.sprintf "{0 %s}\n" pkg.name in - let documentation = - match pkg.mlds with - | _ :: _ -> - Format.sprintf - "{1 Documentation pages}\n\n\ - {{!/%s/doc/index}Documentation for %s}\n" - pkg.name pkg.name - | [] -> "" - in - let libraries = - match pkg.libraries with - | [] -> "" - | _ :: _ -> - Format.sprintf "{1 Libraries}\n\n{{!/%s/lib/index}Libraries for %s}\n" - pkg.name pkg.name - in - title ^ documentation ^ libraries + let content pkg ppf = + fpf ppf "{0 %s}\n" pkg.name; + if not (List.is_empty pkg.mlds) then + fpf ppf + "{1 Documentation pages}@\n@\n{{!/%s/doc/index}Documentation for %s}@\n" + pkg.name pkg.name; + if not (List.is_empty pkg.libraries) then + fpf ppf "{1 Libraries}@\n@\n{{!/%s/lib/index}Libraries for %s}@\n" + pkg.name pkg.name let page ~odoc_dir ~odocl_dir ~mld_dir ~output_dir ~pkg = let content = content pkg in @@ -54,16 +48,15 @@ module PackageLanding = struct end module PackageList = struct - let content all = + let content all ppf = let sorted_packages = all |> List.sort (fun n1 n2 -> String.compare n1.name n2.name) in - let title = "{0 List of all packages}\n" in - let s_of_pkg pkg = - Format.sprintf "- {{!/__driver/%s/index}%s}" pkg.name pkg.name + fpf ppf "{0 List of all packages}@\n"; + let print_pkg pkg = + fpf ppf "- {{!/__driver/%s/index}%s}@\n" pkg.name pkg.name in - let pkg_ul = sorted_packages |> List.map s_of_pkg |> String.concat "\n" in - title ^ pkg_ul + List.iter print_pkg sorted_packages let page ~mld_dir ~odoc_dir ~odocl_dir ~output_dir all = let content = content all in @@ -77,16 +70,13 @@ module PackageList = struct end module LibraryLanding = struct - let content lib = - let title = Format.sprintf "{0 %s}\n" lib.lib_name in - let s_of_module m = - if m.m_hidden then None - else Some (Format.sprintf "- {!%s}" m.Packages.m_name) + let content lib ppf = + fpf ppf "{0 %s}@\n" lib.lib_name; + let print_module m = + if not m.m_hidden then fpf ppf "- {!%s}@\n" m.Packages.m_name in - let modules = - lib.modules |> List.filter_map s_of_module |> String.concat "\n" - in - title ^ modules + List.iter print_module lib.modules + let page ~pkg ~odoc_dir ~odocl_dir ~mld_dir ~output_dir lib = let content = content lib in let rel_path = Fpath.(v pkg.name / "lib" / lib.lib_name) in @@ -99,13 +89,12 @@ module LibraryLanding = struct end module PackageLibLanding = struct - let content pkg = - let title = Format.sprintf "{0 %s}\n" pkg.name in - let s_of_lib (lib : Packages.libty) = - Format.sprintf "- {{!/%s/%s/index}%s}" pkg.name lib.lib_name lib.lib_name + let content pkg ppf = + fpf ppf "{0 %s}@\n" pkg.name; + let print_lib (lib : Packages.libty) = + fpf ppf "- {{!/%s/%s/index}%s}@\n" pkg.name lib.lib_name lib.lib_name in - let libraries = pkg.libraries |> List.map s_of_lib |> String.concat "\n" in - title ^ libraries + List.iter print_lib pkg.libraries let page ~pkg ~odoc_dir ~odocl_dir ~mld_dir ~output_dir = let content = content pkg in diff --git a/src/driver/util.ml b/src/driver/util.ml index 2fc786c226..a74f5a3774 100644 --- a/src/driver/util.ml +++ b/src/driver/util.ml @@ -1,3 +1,4 @@ +open Odoc_utils open Bos module StringSet = Set.Make (String) @@ -17,29 +18,17 @@ let lines_of_process cmd = | Ok x -> x | Error (`Msg e) -> failwith ("Error: " ^ e) -let mkdir_p d = - let segs = - Fpath.segs (Fpath.normalize d) |> List.filter (fun s -> String.length s > 0) - in - let _ = - List.fold_left - (fun path seg -> - let d = Fpath.(path // v seg) in - try - Unix.mkdir (Fpath.to_string d) 0o755; - d - with - | Unix.Unix_error (Unix.EEXIST, _, _) -> d - | exn -> raise exn) - (Fpath.v ".") segs - in - () - -let write_file filename lines = - let dir = fst (Fpath.split_base filename) in - mkdir_p dir; - let oc = open_out (Fpath.to_string filename) in - List.iter (fun line -> Printf.fprintf oc "%s\n" line) lines; - close_out oc +(** Opens a file for writing and calls [f]. The destination directory is created + if needed. *) +let with_out_to filename f = + let open ResultMonad in + OS.Dir.create (Fpath.parent filename) >>= fun _ -> + OS.File.with_oc filename + (fun oc () -> + f oc; + Ok ()) + () + |> Result.join + >>= fun () -> Ok () let cp src dst = assert (lines_of_process Cmd.(v "cp" % src % dst) = []) From dd4773c48e4f1a429758fe82106aeb61a5bc73e1 Mon Sep 17 00:00:00 2001 From: panglesd Date: Wed, 21 Aug 2024 16:42:45 +0200 Subject: [PATCH 8/9] Fix typo Co-authored-by: Jules Aguillon --- src/odoc/asset.ml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/odoc/asset.ml b/src/odoc/asset.ml index 21f8d85405..57222e26d9 100644 --- a/src/odoc/asset.ml +++ b/src/odoc/asset.ml @@ -5,8 +5,7 @@ let compile ~parent_id ~name ~output_dir = let parent_id = match Compile.mk_id parent_id with | Some s -> Ok s - | None -> - Error (`Msg "parent-id cannot be empty when compiling implementations.") + | None -> Error (`Msg "parent-id cannot be empty when compiling assets.") in parent_id >>= fun parent_id -> let id = From 5faa8960d16492d8cc013cbb2dea09e787aa568f Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Fri, 23 Aug 2024 13:21:51 +0200 Subject: [PATCH 9/9] Driver: Fix failure when output dir does not exist --- src/driver/compile.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/src/driver/compile.ml b/src/driver/compile.ml index 6b6525dddd..1eace17a98 100644 --- a/src/driver/compile.ml +++ b/src/driver/compile.ml @@ -227,6 +227,7 @@ let sherlodoc_index_one ~output_dir (index : Odoc_unit.index) = let html_generate output_dir linked = let tbl = Hashtbl.create 10 in + let _ = OS.Dir.create output_dir |> Result.get_ok in Sherlodoc.js Fpath.(output_dir // Sherlodoc.js_file); let compile_index : Odoc_unit.index -> _ = fun index ->