diff --git a/CHANGES.md b/CHANGES.md
index e617528a5b..74fb71fd79 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -26,6 +26,7 @@
(@panglesd, #1076).
- Added a `compile-asset` command (@EmileTrotignon, @panglesd, #1170)
- Allow referencing assets (@panglesd, #1171)
+- Added a `--asset-path` arg to `html-generate` (@panglesd, #1185)
### Changed
diff --git a/src/document/renderer.ml b/src/document/renderer.ml
index db10e9c33d..270f70292d 100644
--- a/src/document/renderer.ml
+++ b/src/document/renderer.ml
@@ -24,7 +24,7 @@ type input =
type 'a t = {
name : string;
render : 'a -> Types.Block.t option -> Types.Document.t -> page list;
- extra_documents : 'a -> input -> Types.Document.t list;
+ filepath : 'a -> Url.Path.t -> Fpath.t;
}
let document_of_page ~syntax v =
diff --git a/src/document/types.ml b/src/document/types.ml
index 34e9b502d9..6ab49a3bfe 100644
--- a/src/document/types.ml
+++ b/src/document/types.ml
@@ -196,13 +196,8 @@ and Source_page : sig
end =
Source_page
-and Asset : sig
- type t = { url : Url.Path.t; src : Fpath.t }
-end =
- Asset
-
module Document = struct
- type t = Page of Page.t | Source_page of Source_page.t | Asset of Asset.t
+ type t = Page of Page.t | Source_page of Source_page.t
end
let inline ?(attr = []) desc = Inline.{ attr; desc }
diff --git a/src/driver/compile.ml b/src/driver/compile.ml
index a9b84c16fb..d42154fa4a 100644
--- a/src/driver/compile.ml
+++ b/src/driver/compile.ml
@@ -2,21 +2,26 @@
type compiled = Odoc_unit.t
-let mk_byhash (pkgs : Odoc_unit.intf Odoc_unit.unit list) =
+let mk_byhash (pkgs : Odoc_unit.t list) =
List.fold_left
- (fun acc (u : Odoc_unit.intf Odoc_unit.unit) ->
+ (fun acc (u : Odoc_unit.t) ->
match u.Odoc_unit.kind with
- | `Intf { hash; _ } -> Util.StringMap.add hash u acc)
+ | `Intf { hash; _ } as kind -> Util.StringMap.add hash { u with kind } acc
+ | _ -> acc)
Util.StringMap.empty pkgs
let init_stats (units : Odoc_unit.t list) =
- let total, total_impl, non_hidden, mlds, indexes =
+ let total, total_impl, non_hidden, mlds, assets, indexes =
List.fold_left
- (fun (total, total_impl, non_hidden, mlds, indexes) (unit : Odoc_unit.t) ->
+ (fun (total, total_impl, non_hidden, mlds, assets, indexes)
+ (unit : Odoc_unit.t) ->
let total = match unit.kind with `Intf _ -> total + 1 | _ -> total in
let total_impl =
match unit.kind with `Impl _ -> total_impl + 1 | _ -> total_impl
in
+ let assets =
+ match unit.kind with `Asset -> assets + 1 | _ -> assets
+ in
let indexes = Fpath.Set.add unit.index.output_file indexes in
let non_hidden =
match unit.kind with
@@ -24,8 +29,8 @@ let init_stats (units : Odoc_unit.t list) =
| _ -> non_hidden
in
let mlds = match unit.kind with `Mld -> mlds + 1 | _ -> mlds in
- (total, total_impl, non_hidden, mlds, indexes))
- (0, 0, 0, 0, Fpath.Set.empty)
+ (total, total_impl, non_hidden, mlds, assets, indexes))
+ (0, 0, 0, 0, 0, Fpath.Set.empty)
units
in
@@ -33,6 +38,7 @@ let init_stats (units : Odoc_unit.t list) =
Atomic.set Stats.stats.total_impls total_impl;
Atomic.set Stats.stats.non_hidden_units non_hidden;
Atomic.set Stats.stats.total_mlds mlds;
+ Atomic.set Stats.stats.total_assets assets;
Atomic.set Stats.stats.total_indexes (Fpath.Set.cardinal indexes)
open Eio.Std
@@ -78,93 +84,99 @@ let find_partials odoc_dir : Odoc_unit.intf Odoc_unit.unit Util.StringMap.t * _
| Error _ -> (* odoc_dir doesn't exist...? *) (Util.StringMap.empty, tbl)
let compile ?partial ~partial_dir ?linked_dir:_ (all : Odoc_unit.t list) =
- (* let linked_dir = Option.value linked_dir ~default:output_dir in *)
- let intf_units, impl_units, mld_units =
- List.fold_left
- (fun (intf_units, impl_units, page_units) (unit : Odoc_unit.t) ->
- match unit with
- | { kind = `Intf _; _ } as intf ->
- (intf :: intf_units, impl_units, page_units)
- | { kind = `Impl _; _ } as impl ->
- (intf_units, impl :: impl_units, page_units)
- | { kind = `Mld; _ } as mld ->
- (intf_units, impl_units, mld :: page_units))
- ([], [], []) all
- in
- let hashes = mk_byhash intf_units in
- let other_hashes, tbl =
- match partial with
- | Some _ -> find_partials partial_dir
- | None -> (Util.StringMap.empty, Hashtbl.create 10)
- in
- let all_hashes =
- Util.StringMap.union (fun _x o1 _o2 -> Some o1) hashes other_hashes
+ let hashes = mk_byhash all in
+ let compile_mod =
+ (* Modules have a more complicated compilation because:
+ - They have dependencies and must be compiled in the right order
+ - In Voodoo mode, there might exists already compiled parts *)
+ let other_hashes, tbl =
+ match partial with
+ | Some _ -> find_partials partial_dir
+ | None -> (Util.StringMap.empty, Hashtbl.create 10)
+ in
+ let all_hashes =
+ Util.StringMap.union (fun _x o1 _o2 -> Some o1) hashes other_hashes
+ in
+ let compile_one compile_other hash =
+ match Util.StringMap.find_opt hash all_hashes with
+ | None ->
+ Logs.debug (fun m -> m "Error locating hash: %s" hash);
+ Error Not_found
+ | Some unit ->
+ let deps = match unit.kind with `Intf { deps; _ } -> deps in
+ let _fibers =
+ Fiber.List.map
+ (fun (other_unit : Odoc_unit.intf Odoc_unit.unit) ->
+ match compile_other other_unit with
+ | Ok r -> Some r
+ | Error _exn ->
+ Logs.debug (fun m ->
+ m
+ "Error during compilation of module %s (hash %s, \
+ required by %s)"
+ (Fpath.filename other_unit.input_file)
+ (match other_unit.kind with
+ | `Intf { hash; _ } -> hash)
+ (Fpath.filename unit.input_file));
+ None)
+ deps
+ in
+ let includes = Fpath.Set.of_list unit.include_dirs in
+ Odoc.compile ~output_dir:unit.output_dir ~input_file:unit.input_file
+ ~includes ~parent_id:unit.parent_id;
+ Atomic.incr Stats.stats.compiled_units;
+
+ Ok unit
+ in
+ let rec compile_mod :
+ Odoc_unit.intf Odoc_unit.unit ->
+ (Odoc_unit.intf Odoc_unit.unit, exn) Result.t =
+ fun unit ->
+ let hash = match unit.kind with `Intf { hash; _ } -> hash in
+ match Hashtbl.find_opt tbl hash with
+ | Some p -> Promise.await p
+ | None ->
+ let p, r = Promise.create () in
+ Hashtbl.add tbl hash p;
+ let result = compile_one compile_mod hash in
+ Promise.resolve r result;
+ result
+ in
+ compile_mod
in
- let compile_one compile_other hash =
- match Util.StringMap.find_opt hash all_hashes with
- | None ->
- Logs.debug (fun m -> m "Error locating hash: %s" hash);
- Error Not_found
- | Some unit ->
- let deps = match unit.kind with `Intf { deps; _ } -> deps in
- let _fibers =
- Fiber.List.map
- (fun other_unit ->
- match compile_other other_unit with
- | Ok r -> Some r
- | Error _exn ->
- Logs.debug (fun m ->
- m "Missing module %s (hash %s, required by %s)" "TODO"
- (* n h *) "TODO" "TODO" (* unit.m_name *));
- None)
- deps
- in
+
+ let compile (unit : Odoc_unit.t) =
+ match unit.kind with
+ | `Intf _ as kind ->
+ (compile_mod { unit with kind } :> (Odoc_unit.t, _) Result.t)
+ | `Impl src ->
+ let includes = Fpath.Set.of_list unit.include_dirs in
+ let source_id = src.src_id in
+ Odoc.compile_impl ~output_dir:unit.output_dir
+ ~input_file:unit.input_file ~includes ~parent_id:unit.parent_id
+ ~source_id;
+ Atomic.incr Stats.stats.compiled_impls;
+ Ok unit
+ | `Asset ->
+ Odoc.compile_asset ~output_dir:unit.output_dir ~parent_id:unit.parent_id
+ ~name:(Fpath.filename unit.input_file);
+ Atomic.incr Stats.stats.compiled_assets;
+ Ok unit
+ | `Mld ->
let includes = Fpath.Set.of_list unit.include_dirs in
Odoc.compile ~output_dir:unit.output_dir ~input_file:unit.input_file
~includes ~parent_id:unit.parent_id;
- Atomic.incr Stats.stats.compiled_units;
-
+ Atomic.incr Stats.stats.compiled_mlds;
Ok unit
in
-
- let rec compile_mod :
- Odoc_unit.intf Odoc_unit.unit ->
- (Odoc_unit.intf Odoc_unit.unit, exn) Result.t =
- fun unit ->
- let hash = match unit.kind with `Intf { hash; _ } -> hash in
- match Hashtbl.find_opt tbl hash with
- | Some p -> Promise.await p
- | None ->
- let p, r = Promise.create () in
- Hashtbl.add tbl hash p;
- let result = compile_one compile_mod hash in
- Promise.resolve r result;
- result
- in
- let to_build = Util.StringMap.bindings hashes |> List.map snd in
- let mod_results = Fiber.List.map compile_mod to_build in
- let compile_mld (unit : Odoc_unit.mld Odoc_unit.unit) =
- let includes = Fpath.Set.of_list unit.include_dirs in
- Odoc.compile ~output_dir:unit.output_dir ~input_file:unit.input_file
- ~includes ~parent_id:unit.parent_id;
- Atomic.incr Stats.stats.compiled_mlds
- in
- let () = Fiber.List.iter compile_mld mld_units in
- let compile_impl (unit : Odoc_unit.impl Odoc_unit.unit) =
- let includes = Fpath.Set.of_list unit.include_dirs in
- let source_id = match unit.kind with `Impl src -> src.src_id in
- Odoc.compile_impl ~output_dir:unit.output_dir ~input_file:unit.input_file
- ~includes ~parent_id:unit.parent_id ~source_id;
- Atomic.incr Stats.stats.compiled_impls
- in
- let () = Fiber.List.iter compile_impl impl_units in
- let zipped_res =
- List.map2
- (fun Odoc_unit.{ kind = `Intf { hash; _ }; _ } b -> (hash, b))
- to_build mod_results
- in
+ let res = Fiber.List.map compile all in
+ (* For voodoo mode, we need to keep which modules successfully compiled *)
let zipped =
- List.filter_map (function a, Ok b -> Some (a, b) | _ -> None) zipped_res
+ List.filter_map
+ (function
+ | Ok (Odoc_unit.{ kind = `Intf { hash; _ }; _ } as b) -> Some (hash, b)
+ | _ -> None)
+ res
in
(match partial with
| Some l -> marshal (zipped, hashes) Fpath.(l / "index.m")
@@ -193,6 +205,7 @@ let link : compiled list -> _ =
(match c.kind with
| `Intf _ -> Atomic.incr Stats.stats.linked_units
| `Mld -> Atomic.incr Stats.stats.linked_mlds
+ | `Asset -> ()
| `Impl _ -> Atomic.incr Stats.stats.linked_impls);
c
in
@@ -239,6 +252,9 @@ let html_generate output_dir linked =
Odoc.html_generate_source ~search_uris:[] ~output_dir ~input_file
~source:src_path ();
Atomic.incr Stats.stats.generated_units
+ | `Asset ->
+ 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
diff --git a/src/driver/dune_style.ml b/src/driver/dune_style.ml
index a626d59a18..54a67f514f 100644
--- a/src/driver/dune_style.ml
+++ b/src/driver/dune_style.ml
@@ -53,6 +53,9 @@ let of_dune_build dir =
version = "1.0";
libraries = [ lib ];
mlds = [];
+ assets =
+ []
+ (* When dune has a notion of doc assets, do something *);
pkg_dir;
other_docs = Fpath.Set.empty;
} )
diff --git a/src/driver/odoc.ml b/src/driver/odoc.ml
index ed3bdc579a..aa5d9855e4 100644
--- a/src/driver/odoc.ml
+++ b/src/driver/odoc.ml
@@ -45,6 +45,20 @@ let compile ~output_dir ~input_file:file ~includes ~parent_id =
Cmd_outputs.(
add_prefixed_output cmd compile_output (Fpath.to_string file) lines)
+let compile_asset ~output_dir ~name ~parent_id =
+ let open Cmd in
+ let output_file =
+ Some Fpath.(output_dir // 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 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)
+
let compile_impl ~output_dir ~input_file:file ~includes ~parent_id ~source_id =
let open Cmd in
let includes =
@@ -129,23 +143,19 @@ let compile_index ?(ignore_output = false) ~output_file ~json ~docs ~libs () =
Cmd_outputs.(
add_prefixed_output cmd link_output (Fpath.to_string output_file) lines)
-let html_generate ~output_dir ?index ?(ignore_output = false) ?(assets = [])
+let html_generate ~output_dir ?index ?(ignore_output = false)
?(search_uris = []) ~input_file:file () =
let open Cmd in
let index =
match index with None -> empty | Some idx -> v "--index" % p idx
in
- let assets =
- List.fold_left (fun acc filename -> acc % "--asset" % filename) empty assets
- in
let search_uris =
List.fold_left
(fun acc filename -> acc % "--search-uri" % p filename)
empty search_uris
in
let cmd =
- !odoc % "html-generate" % p file %% assets %% index %% search_uris % "-o"
- % output_dir
+ !odoc % "html-generate" % p file %% index %% search_uris % "-o" % output_dir
in
let desc = Printf.sprintf "Generating HTML for %s" (Fpath.to_string file) in
let lines = Cmd_outputs.submit desc cmd None in
@@ -153,6 +163,19 @@ let html_generate ~output_dir ?index ?(ignore_output = false) ?(assets = [])
Cmd_outputs.(
add_prefixed_output cmd generate_output (Fpath.to_string file) lines)
+let html_generate_asset ~output_dir ?(ignore_output = false) ~input_file:file
+ ~asset_path () =
+ let open Cmd in
+ let cmd =
+ !odoc % "html-generate-asset" % "-o" % output_dir % "--asset-unit" % p file
+ % p asset_path
+ in
+ let desc = Printf.sprintf "Copying asset %s" (Fpath.to_string file) in
+ let lines = Cmd_outputs.submit desc cmd None in
+ if not ignore_output then
+ Cmd_outputs.(
+ add_prefixed_output cmd generate_output (Fpath.to_string file) lines)
+
let html_generate_source ~output_dir ?(ignore_output = false) ~source
?(search_uris = []) ~input_file:file () =
let open Cmd in
@@ -163,7 +186,7 @@ let html_generate_source ~output_dir ?(ignore_output = false) ~source
empty search_uris
in
let cmd =
- !odoc % "html-generate-impl" %% file % p source %% search_uris % "-o"
+ !odoc % "html-generate-source" %% file % p source %% search_uris % "-o"
% output_dir
in
let desc = Printf.sprintf "Generating HTML for %s" (Fpath.to_string source) in
diff --git a/src/driver/odoc.mli b/src/driver/odoc.mli
index a9cb57b392..06ae01fcf3 100644
--- a/src/driver/odoc.mli
+++ b/src/driver/odoc.mli
@@ -24,6 +24,8 @@ val compile :
parent_id:id ->
unit
+val compile_asset : output_dir:Fpath.t -> name:string -> parent_id:id -> unit
+
val link :
?ignore_output:bool ->
input_file:Fpath.t ->
@@ -48,12 +50,19 @@ val html_generate :
output_dir:string ->
?index:Fpath.t ->
?ignore_output:bool ->
- ?assets:string list ->
?search_uris:Fpath.t list ->
input_file:Fpath.t ->
unit ->
unit
+val html_generate_asset :
+ output_dir:string ->
+ ?ignore_output:bool ->
+ input_file:Fpath.t ->
+ asset_path:Fpath.t ->
+ unit ->
+ unit
+
val html_generate_source :
output_dir:string ->
?ignore_output:bool ->
diff --git a/src/driver/odoc_driver.ml b/src/driver/odoc_driver.ml
index 069eda6c25..7d92dfc365 100644
--- a/src/driver/odoc_driver.ml
+++ b/src/driver/odoc_driver.ml
@@ -451,6 +451,7 @@ let render_stats env nprocs =
let total = Atomic.get Stats.stats.total_units in
let total_impls = Atomic.get Stats.stats.total_impls in
let total_mlds = Atomic.get Stats.stats.total_mlds in
+ let total_assets = Atomic.get Stats.stats.total_assets in
let total_indexes = Atomic.get Stats.stats.total_indexes in
let bar message total =
let open Progress.Line in
@@ -474,6 +475,7 @@ let render_stats env nprocs =
dline "Compiling" total
++ dline "Compiling impls" total_impls
++ dline "Compiling pages" total_mlds
+ ++ dline "Compiling assets" total_assets
++ dline "Linking" non_hidden
++ dline "Linking impls" total_impls
++ dline "Linking mlds" total_mlds
@@ -481,12 +483,14 @@ let render_stats env nprocs =
++ dline "HTML" (total_impls + non_hidden + total_mlds)
++ line (procs nprocs)
++ descriptions)
- (fun comp compimpl compmld link linkimpl linkmld indexes html procs descr ->
- let rec inner (a, b, c, d, e, f, i, g, h) =
+ (fun comp compimpl compmld compassets link linkimpl linkmld indexes html
+ procs descr ->
+ let rec inner (a, b, c, j, d, e, f, i, g, h) =
Eio.Time.sleep clock 0.1;
let a' = Atomic.get Stats.stats.compiled_units in
let b' = Atomic.get Stats.stats.compiled_impls in
let c' = Atomic.get Stats.stats.compiled_mlds in
+ let j' = Atomic.get Stats.stats.compiled_assets in
let d' = Atomic.get Stats.stats.linked_units in
let e' = Atomic.get Stats.stats.linked_impls in
let f' = Atomic.get Stats.stats.linked_mlds in
@@ -499,6 +503,7 @@ let render_stats env nprocs =
comp (a' - a);
compimpl (b' - b);
compmld (c' - c);
+ compassets (j' - j);
link (d' - d);
linkimpl (e' - e);
linkmld (f' - f);
@@ -506,9 +511,9 @@ let render_stats env nprocs =
html (g' - g);
procs (h' - h);
if g' < non_hidden + total_impls + total_mlds then
- inner (a', b', c', d', e', f', i', g', h')
+ inner (a', b', c', j', d', e', f', i', g', h')
in
- inner (0, 0, 0, 0, 0, 0, 0, 0, 0))
+ inner (0, 0, 0, 0, 0, 0, 0, 0, 0, 0))
let run libs verbose packages_dir odoc_dir odocl_dir html_dir stats nb_workers
odoc_bin voodoo package_name blessed dune_style =
diff --git a/src/driver/odoc_unit.ml b/src/driver/odoc_unit.ml
index c55472e3f8..685dd5464e 100644
--- a/src/driver/odoc_unit.ml
+++ b/src/driver/odoc_unit.ml
@@ -32,7 +32,9 @@ type impl = [ `Impl of impl_extra ]
type mld = [ `Mld ]
-type t = [ impl | intf | mld ] unit
+type asset = [ `Asset ]
+
+type t = [ impl | intf | mld | asset ] unit
let of_packages ~output_dir ~linked_dir ~index_dir (pkgs : Packages.t list) :
t list =
@@ -90,14 +92,13 @@ let of_packages ~output_dir ~linked_dir ~index_dir (pkgs : Packages.t list) :
let output_file = Fpath.(index_dir / pkg.name / Odoc.index_filename) in
{ pkg_args; output_file; json = false; search_dir = pkg.pkg_dir }
in
- let make_unit ~kind ~rel_dir ~input_file ~prefix ~pkg ~include_dirs : _ unit =
+ let make_unit ~name ~kind ~rel_dir ~input_file ~pkg ~include_dirs : _ unit =
let ( // ) = Fpath.( // ) in
let ( / ) = Fpath.( / ) in
- let filename = input_file |> Fpath.rem_ext |> Fpath.basename in
let odoc_dir = output_dir // rel_dir in
let parent_id = rel_dir |> Odoc.id_of_fpath in
- let odoc_file = odoc_dir / (prefix ^ filename ^ ".odoc") in
- let odocl_file = linked_dir // rel_dir / (prefix ^ filename ^ ".odocl") in
+ let odoc_file = odoc_dir / (name ^ ".odoc") in
+ let odocl_file = linked_dir // rel_dir / (name ^ ".odocl") in
{
output_dir;
pkgname = pkg.Packages.name;
@@ -134,7 +135,8 @@ let of_packages ~output_dir ~linked_dir ~index_dir (pkgs : Packages.t list) :
let kind = `Intf { hidden; hash = intf.mif_hash; deps } in
(include_dirs, kind)
in
- make_unit ~kind ~rel_dir ~prefix:"" ~input_file:intf.mif_path ~pkg
+ let name = intf.mif_path |> Fpath.rem_ext |> Fpath.basename in
+ make_unit ~name ~kind ~rel_dir ~input_file:intf.mif_path ~pkg
~include_dirs
in
let of_impl pkg libname (impl : Packages.impl) : impl unit option =
@@ -154,9 +156,12 @@ let of_packages ~output_dir ~linked_dir ~index_dir (pkgs : Packages.t list) :
in
`Impl { src_id; src_path }
in
+ let name =
+ impl.mip_path |> Fpath.rem_ext |> Fpath.basename |> ( ^ ) "impl-"
+ in
let unit =
- make_unit ~kind ~rel_dir ~input_file:impl.mip_path ~pkg ~include_dirs
- ~prefix:"impl-"
+ make_unit ~name ~kind ~rel_dir ~input_file:impl.mip_path ~pkg
+ ~include_dirs
in
Some unit
in
@@ -187,15 +192,31 @@ let of_packages ~output_dir ~linked_dir ~index_dir (pkgs : Packages.t list) :
in
let include_dirs = (output_dir // rel_dir) :: include_dirs in
let kind = `Mld in
+ let name = mld_path |> Fpath.rem_ext |> Fpath.basename |> ( ^ ) "page-" in
+ let unit =
+ make_unit ~name ~kind ~rel_dir ~input_file:mld_path ~pkg ~include_dirs
+ in
+ [ unit ]
+ in
+ let of_asset pkg (asset : Packages.asset) : asset unit list =
+ let open Fpath in
+ let { Packages.asset_path; asset_rel_path } = asset in
+ let rel_dir =
+ pkg.Packages.pkg_dir / "doc" // Fpath.parent asset_rel_path
+ |> Fpath.normalize
+ in
+ let include_dirs = [] in
+ let kind = `Asset in
let unit =
- make_unit ~kind ~rel_dir ~input_file:mld_path ~pkg ~include_dirs
- ~prefix:"page-"
+ let name = asset_path |> Fpath.basename |> ( ^ ) "asset-" in
+ make_unit ~name ~kind ~rel_dir ~input_file:asset_path ~pkg ~include_dirs
in
[ unit ]
in
let of_package (pkg : Packages.t) : t list =
let lib_units :> t list list = List.map (of_lib pkg) pkg.libraries in
let mld_units :> t list list = List.map (of_mld pkg) pkg.mlds in
- List.concat (List.rev_append lib_units mld_units)
+ let asset_units :> t list list = List.map (of_asset pkg) pkg.assets in
+ List.concat (lib_units @ mld_units @ asset_units)
in
List.concat_map of_package pkgs
diff --git a/src/driver/odoc_unit.mli b/src/driver/odoc_unit.mli
index d27f12c0ca..be617ee12c 100644
--- a/src/driver/odoc_unit.mli
+++ b/src/driver/odoc_unit.mli
@@ -32,7 +32,9 @@ type impl = [ `Impl of impl_extra ]
type mld = [ `Mld ]
-type t = [ impl | intf | mld ] unit
+type asset = [ `Asset ]
+
+type t = [ impl | intf | mld | asset ] unit
val of_packages :
output_dir:Fpath.t ->
diff --git a/src/driver/opam.ml b/src/driver/opam.ml
index f167d3c6ed..23e43de9a8 100644
--- a/src/driver/opam.ml
+++ b/src/driver/opam.ml
@@ -135,6 +135,10 @@ let pkg_to_dir_map () =
| "doc" :: _pkg :: "odoc-pages" :: _ ->
Logs.debug (fun m -> m "Found odoc page: %a" Fpath.pp fpath);
+ (Fpath.Set.add Fpath.(v prefix // fpath) odoc_pages, others)
+ | "doc" :: _pkg :: "odoc-assets" :: _ ->
+ Logs.debug (fun m -> m "Found odoc page: %a" Fpath.pp fpath);
+
(Fpath.Set.add Fpath.(v prefix // fpath) odoc_pages, others)
| "doc" :: _ ->
Logs.debug (fun m -> m "Found other doc: %a" Fpath.pp fpath);
diff --git a/src/driver/packages.ml b/src/driver/packages.ml
index ee4523ec4d..bc7dde6008 100644
--- a/src/driver/packages.ml
+++ b/src/driver/packages.ml
@@ -29,6 +29,10 @@ type mld = { mld_path : Fpath.t; mld_rel_path : Fpath.t }
let pp_mld fmt m = Format.fprintf fmt "%a" Fpath.pp m.mld_path
+type asset = { asset_path : Fpath.t; asset_rel_path : Fpath.t }
+
+let pp_asset fmt m = Format.fprintf fmt "%a" Fpath.pp m.asset_path
+
type libty = {
lib_name : string;
archive_name : string;
@@ -40,6 +44,7 @@ type t = {
version : string;
libraries : libty list;
mlds : mld list;
+ assets : asset list;
other_docs : Fpath.Set.t;
pkg_dir : Fpath.t;
}
@@ -276,14 +281,34 @@ let of_libs ~packages_dir libs =
in
ignore libname_of_archive;
let mk_mlds pkg_name odoc_pages =
+ let odig_convention asset_path =
+ let asset_prefix =
+ Fpath.(v (Opam.prefix ()) / "doc" / pkg_name / "odoc-assets")
+ in
+ let rel_path = Fpath.rem_prefix asset_prefix asset_path in
+ match rel_path with
+ | None -> []
+ | Some rel_path ->
+ [ { asset_path; asset_rel_path = Fpath.(v "_assets" // rel_path) } ]
+ in
let prefix = Fpath.(v (Opam.prefix ()) / "doc" / pkg_name / "odoc-pages") in
- Fpath.Set.fold
- (fun mld_path acc ->
- let rel_path = Fpath.rem_prefix prefix mld_path in
- match rel_path with
- | None -> acc
- | Some mld_rel_path -> { mld_path; mld_rel_path } :: acc)
- odoc_pages []
+ let mlds, assets =
+ Fpath.Set.fold
+ (fun path (mld_acc, asset_acc) ->
+ let rel_path = Fpath.rem_prefix prefix path in
+ match rel_path with
+ | None -> (mld_acc, odig_convention path @ asset_acc)
+ | Some rel_path ->
+ if Fpath.has_ext "mld" path then
+ ( { mld_path = path; mld_rel_path = rel_path } :: mld_acc,
+ asset_acc )
+ else
+ ( mld_acc,
+ { asset_path = path; asset_rel_path = rel_path } :: asset_acc
+ ))
+ odoc_pages ([], [])
+ in
+ (mlds, assets)
in
Fpath.Map.fold
(fun dir archives acc ->
@@ -310,7 +335,7 @@ let of_libs ~packages_dir libs =
pkg = pkg')
map
in
- let mlds = mk_mlds pkg'.name odoc_pages in
+ let mlds, assets = mk_mlds pkg'.name odoc_pages in
Logs.debug (fun m ->
m "%d mlds for package %s (from %d odoc_pages)" (List.length mlds)
pkg.name
@@ -327,6 +352,7 @@ let of_libs ~packages_dir libs =
version = pkg.version;
libraries;
mlds;
+ assets;
other_docs;
pkg_dir;
})
diff --git a/src/driver/packages.mli b/src/driver/packages.mli
index ee4f766663..7e2f7ab7ca 100644
--- a/src/driver/packages.mli
+++ b/src/driver/packages.mli
@@ -35,6 +35,12 @@ type mld = { mld_path : Fpath.t; mld_rel_path : Fpath.t }
val pp_mld : Format.formatter -> mld -> unit
+(** {1 Asset units} *)
+
+type asset = { asset_path : Fpath.t; asset_rel_path : Fpath.t }
+
+val pp_asset : Format.formatter -> asset -> unit
+
(** {1 Packages} *)
(** Compilation units are associated to libraries, while documentation are
@@ -63,6 +69,7 @@ type t = {
version : string;
libraries : libty list;
mlds : mld list;
+ assets : asset list;
other_docs : Fpath.Set.t;
pkg_dir : Fpath.t;
}
diff --git a/src/driver/stats.ml b/src/driver/stats.ml
index 70d9c9608b..13624e42f0 100644
--- a/src/driver/stats.ml
+++ b/src/driver/stats.ml
@@ -6,11 +6,13 @@ type stats = {
mutable total_units : int Atomic.t;
mutable total_impls : int Atomic.t;
mutable total_mlds : int Atomic.t;
+ mutable total_assets : int Atomic.t;
mutable total_indexes : int Atomic.t;
mutable non_hidden_units : int Atomic.t;
mutable compiled_units : int Atomic.t;
mutable compiled_impls : int Atomic.t;
mutable compiled_mlds : int Atomic.t;
+ mutable compiled_assets : int Atomic.t;
mutable linked_units : int Atomic.t;
mutable linked_impls : int Atomic.t;
mutable linked_mlds : int Atomic.t;
@@ -25,11 +27,13 @@ let stats =
total_units = Atomic.make 0;
total_impls = Atomic.make 0;
total_mlds = Atomic.make 0;
+ total_assets = Atomic.make 0;
total_indexes = Atomic.make 0;
non_hidden_units = Atomic.make 0;
compiled_units = Atomic.make 0;
compiled_impls = Atomic.make 0;
compiled_mlds = Atomic.make 0;
+ compiled_assets = Atomic.make 0;
linked_units = Atomic.make 0;
linked_impls = Atomic.make 0;
linked_mlds = Atomic.make 0;
diff --git a/src/driver/voodoo.ml b/src/driver/voodoo.ml
index 8e328687b7..ee09ff3615 100644
--- a/src/driver/voodoo.ml
+++ b/src/driver/voodoo.ml
@@ -50,32 +50,50 @@ let process_package pkg =
let pkg_path =
Fpath.(v "prep" / "universes" / pkg.universe / pkg.name / pkg.version)
in
-
- let mlds =
+ let assets, mlds =
List.filter_map
(fun p ->
let prefix = Fpath.(v "doc" / pkg.name / "odoc-pages") in
-
+ let asset_prefix = Fpath.(v "doc" / pkg.name / "odoc-assets") in
+ let check_name pkg_name =
+ if pkg_name <> pkg.name then (
+ Logs.err (fun k ->
+ k
+ "Error: name in 'doc' dir does not match package name: %s <> \
+ %s"
+ pkg_name pkg.name);
+ None)
+ else Some ()
+ in
+ let ( >>= ) = Option.bind in
match Fpath.segs p with
| "doc" :: pkg_name :: "odoc-pages" :: _ :: _ -> (
- if pkg_name <> pkg.name then (
- Logs.err (fun k ->
- k
- "Error: name in 'doc' dir does not match package name: %s \
- <> %s"
- pkg_name pkg.name);
- None)
- else
- let rel_path = Fpath.rem_prefix prefix p in
- match rel_path with
- | None -> None
- | Some mld_rel_path ->
+ check_name pkg_name >>= fun () ->
+ match Fpath.rem_prefix prefix p with
+ | None -> None
+ | Some rel_path ->
+ let path = Fpath.(pkg_path // p) in
+ if Fpath.has_ext "mld" p then
Some
- { Packages.mld_path = Fpath.(pkg_path // p); mld_rel_path })
+ (`M { Packages.mld_path = path; mld_rel_path = rel_path })
+ else
+ Some
+ (`A
+ { Packages.asset_path = path; asset_rel_path = rel_path })
+ )
+ | "doc" :: pkg_name :: "odoc-assets" :: _ :: _ -> (
+ check_name pkg_name >>= fun () ->
+ match Fpath.rem_prefix asset_prefix p with
+ | None -> None
+ | Some asset_rel_path ->
+ let asset_path = Fpath.(pkg_path // p) in
+ Some (`A { Packages.asset_path; asset_rel_path }))
| _ -> None)
pkg.files
+ |> List.partition_map (function
+ | `A asset -> Either.Left asset
+ | `M mld -> Either.Right mld)
in
-
let libraries =
List.filter_map
(fun meta_file ->
@@ -156,6 +174,7 @@ let process_package pkg =
version = pkg.version;
libraries;
mlds;
+ assets;
other_docs = Fpath.Set.empty;
pkg_dir = top_dir pkg;
}
diff --git a/src/html/generator.ml b/src/html/generator.ml
index cdedd10326..58c5e34b27 100644
--- a/src/html/generator.ml
+++ b/src/html/generator.ml
@@ -535,32 +535,14 @@ module Page = struct
if Config.as_json config then
Html_fragment_json.make_src ~config ~url ~breadcrumbs [ doc ]
else Html_page.make_src ~breadcrumbs ~header ~config ~url title [ doc ]
-
- let asset ~config { Asset.url; src } =
- let filename = Link.Path.as_filename ~is_flat:(Config.flat config) url in
- let content ppf =
- let ic = open_in_bin (Fpath.to_string src) in
- let len = 1024 in
- let buf = Bytes.create len in
- let rec loop () =
- let read = input ic buf 0 len in
- if read = len then (
- Format.fprintf ppf "%s" (Bytes.to_string buf);
- loop ())
- else if len > 0 then
- let buf = Bytes.sub buf 0 read in
- Format.fprintf ppf "%s" (Bytes.to_string buf)
- in
- loop ();
- close_in ic
- in
- { Odoc_document.Renderer.filename; content; children = [] }
end
let render ~config ~sidebar = function
| Document.Page page -> [ Page.page ~config ~sidebar page ]
| Source_page src -> [ Page.source_page ~config src ]
- | Asset asset -> [ Page.asset ~config asset ]
+
+let filepath ~config url =
+ Link.Path.as_filename ~is_flat:(Config.flat config) url
let doc ~config ~xref_base_uri b =
let resolve = Link.Base xref_base_uri in
diff --git a/src/html/generator.mli b/src/html/generator.mli
index c08ef80e08..446d2346f7 100644
--- a/src/html/generator.mli
+++ b/src/html/generator.mli
@@ -4,6 +4,8 @@ val render :
Odoc_document.Types.Document.t ->
Odoc_document.Renderer.page list
+val filepath : config:Config.t -> Odoc_document.Url.Path.t -> Fpath.t
+
val doc :
config:Config.t ->
xref_base_uri:string ->
diff --git a/src/latex/generator.ml b/src/latex/generator.ml
index 63f5cc7f7b..470edec96d 100644
--- a/src/latex/generator.ml
+++ b/src/latex/generator.ml
@@ -40,10 +40,10 @@ module Link = struct
( List.map segment_to_string dir,
String.concat "." (List.map segment_to_string file) )
- let filename url =
+ let filename ?(add_ext = true) url =
let dir, file = get_dir_and_file url in
let file = Fpath.(v (String.concat dir_sep (dir @ [ file ]))) in
- Fpath.(add_ext "tex" file)
+ if add_ext then Fpath.add_ext "tex" file else file
end
let style = function
@@ -477,4 +477,6 @@ end
let render ~with_children = function
| Document.Page page -> [ Page.page ~with_children page ]
- | Source_page _ | Asset _ -> []
+ | Source_page _ -> []
+
+let filepath url = Link.filename ~add_ext:false url
diff --git a/src/latex/generator.mli b/src/latex/generator.mli
index 3140da0418..d1b6c177aa 100644
--- a/src/latex/generator.mli
+++ b/src/latex/generator.mli
@@ -6,3 +6,5 @@ val render :
with_children:bool ->
Odoc_document.Types.Document.t ->
Odoc_document.Renderer.page list
+
+val filepath : Odoc_document.Url.Path.t -> Fpath.t
diff --git a/src/manpage/generator.ml b/src/manpage/generator.ml
index ccb98f618e..bee3f87751 100644
--- a/src/manpage/generator.ml
+++ b/src/manpage/generator.ml
@@ -562,4 +562,6 @@ and render_page (p : Page.t) =
let render = function
| Document.Page page -> [ render_page page ]
- | Source_page _ | Asset _ -> []
+ | Source_page _ -> []
+
+let filepath url = Link.as_filename ~add_ext:false url
diff --git a/src/manpage/generator.mli b/src/manpage/generator.mli
index 4d80e7664c..e3b0cbed61 100644
--- a/src/manpage/generator.mli
+++ b/src/manpage/generator.mli
@@ -1 +1,3 @@
val render : Odoc_document.Types.Document.t -> Odoc_document.Renderer.page list
+
+val filepath : Odoc_document.Url.Path.t -> Fpath.t
diff --git a/src/manpage/link.ml b/src/manpage/link.ml
index 5be2bf9458..f007aa5510 100644
--- a/src/manpage/link.ml
+++ b/src/manpage/link.ml
@@ -7,7 +7,7 @@ let segment_to_string (kind, name) =
| `Module | `Page | `LeafPage | `Class -> name
| _ -> Format.asprintf "%a-%s" Odoc_document.Url.Path.pp_kind kind name
-let as_filename (url : Url.Path.t) =
+let as_filename ?(add_ext = true) (url : Url.Path.t) =
let components = Url.Path.to_list url in
let dir, path =
Url.Path.split
@@ -17,7 +17,7 @@ let as_filename (url : Url.Path.t) =
let dir = List.map segment_to_string dir in
let path = String.concat "." (List.map segment_to_string path) in
let str_path = String.concat Fpath.dir_sep (dir @ [ path ]) in
- Fpath.(v str_path + ".3o")
+ if add_ext then Fpath.(v str_path + ".3o") else Fpath.v str_path
let rec is_class_or_module_path (url : Url.Path.t) =
match url.kind with
diff --git a/src/model/lang.ml b/src/model/lang.ml
index 51b53e153d..f65154e4ad 100644
--- a/src/model/lang.ml
+++ b/src/model/lang.ml
@@ -525,11 +525,7 @@ end =
Implementation
module rec Page : sig
- type child =
- | Page_child of string
- | Module_child of string
- | Source_tree_child of string
- | Asset_child of string
+ type child = Page_child of string | Module_child of string
type t = {
name : Identifier.Page.t;
diff --git a/src/odoc/bin/main.ml b/src/odoc/bin/main.ml
index ff3c741ee7..bc8ccccd81 100644
--- a/src/odoc/bin/main.ml
+++ b/src/odoc/bin/main.ml
@@ -651,6 +651,9 @@ end = struct
let is_page input =
input |> Fpath.filename |> Astring.String.is_prefix ~affix:"page-"
+ let is_asset input =
+ input |> Fpath.filename |> Astring.String.is_prefix ~affix:"asset-"
+
let link directories page_roots lib_roots input_file output_file
current_package warnings_options open_modules =
let input = Fs.File.of_string input_file in
@@ -664,10 +667,12 @@ end = struct
(`Msg "Arguments given to -P and -L cannot be included in each others")
else Ok ())
>>= fun () ->
- let is_page = is_page input in
- (if is_page then Ok None else current_library_of_input lib_roots input)
+ let is_page_or_asset = is_page input || is_asset input in
+ (if is_page_or_asset then Ok None
+ else current_library_of_input lib_roots input)
>>= fun current_lib ->
- (if is_page then current_package_of_page ~current_package page_roots input
+ (if is_page_or_asset then
+ current_package_of_page ~current_package page_roots input
else validate_current_package page_roots current_package)
>>= fun current_package ->
let current_dir = Fs.File.dirname output in
@@ -779,6 +784,8 @@ module Make_renderer (R : S) : sig
val generate : docs:string -> unit Term.t * Term.info
val generate_source : docs:string -> unit Term.t * Term.info
+
+ val generate_asset : docs:string -> unit Term.t * Term.info
end = struct
let input_odoc =
let doc = "Input file." in
@@ -906,6 +913,42 @@ end = struct
let generate_source ~docs = Generate_source.(cmd, info ~docs)
+ module Generate_asset = struct
+ let generate extra output_dir extra_suffix input_file warnings_options
+ asset_file =
+ Rendering.generate_asset_odoc ~renderer:R.renderer ~warnings_options
+ ~output:output_dir ~extra_suffix ~asset_file extra input_file
+
+ let input_odocl =
+ let doc = "Odoc asset unit." in
+ Arg.(
+ required
+ & opt (some convert_fpath) None
+ & info [ "asset-unit" ] ~doc ~docv:"asset-FILE.odocl")
+
+ let asset_file =
+ let doc = "The asset file" in
+ Arg.(
+ required
+ & pos 0 (some convert_fpath) None
+ & info ~doc ~docv:"FILE.ext" [])
+
+ let cmd =
+ Term.(
+ const handle_error
+ $ (const generate $ R.extra_args $ dst ~create:true () $ extra_suffix
+ $ input_odocl $ warnings_options $ asset_file))
+
+ let info ~docs =
+ let doc =
+ Format.sprintf "Generate %s files from a $(i,impl-*.odocl)."
+ R.renderer.name
+ in
+ Term.info ~docs ~doc (R.renderer.name ^ "-generate-asset")
+ end
+
+ let generate_asset ~docs = Generate_asset.(cmd, info ~docs)
+
module Targets = struct
let list_targets output_dir directories extra odoc_file =
let odoc_file = Fs.File.of_string odoc_file in
@@ -1131,27 +1174,19 @@ module Odoc_html_args = struct
in
Arg.(value & flag & info ~doc [ "as-json" ])
- let assets =
- let doc =
- "Assets files. These must match the assets listed as children during the \
- compile phase."
- in
- Arg.(
- value & opt_all convert_fpath [] & info [ "asset" ] ~doc ~docv:"file.ext")
-
let extra_args =
let config semantic_uris closed_details indent theme_uri support_uri
- search_uris flat as_json assets =
+ search_uris flat as_json =
let open_details = not closed_details in
let html_config =
Odoc_html.Config.v ~theme_uri ~support_uri ~search_uris ~semantic_uris
~indent ~flat ~open_details ~as_json ()
in
- { Html_page.html_config; assets }
+ { Html_page.html_config }
in
Term.(
const config $ semantic_uris $ closed_details $ indent $ theme_uri
- $ support_uri $ search_uri $ flat $ as_json $ assets)
+ $ support_uri $ search_uri $ flat $ as_json)
end
module Odoc_html = Make_renderer (Odoc_html_args)
@@ -1535,6 +1570,7 @@ let () =
Odoc_link.(cmd, info ~docs:section_pipeline);
Odoc_html.generate ~docs:section_pipeline;
Odoc_html.generate_source ~docs:section_pipeline;
+ Odoc_html.generate_asset ~docs:section_pipeline;
Support_files_command.(cmd, info ~docs:section_pipeline);
Compile_impl.(cmd, info ~docs:section_pipeline);
Indexing.(cmd, info ~docs:section_pipeline);
diff --git a/src/odoc/compile.ml b/src/odoc/compile.ml
index 432a151fe2..09e59a68aa 100644
--- a/src/odoc/compile.ml
+++ b/src/odoc/compile.ml
@@ -71,8 +71,6 @@ let parse_parent_child_reference s =
in
match String.cut ~sep:"-" s with
| Some ("page", n) -> Ok (Lang.Page.Page_child (unquote n))
- | Some ("srctree", n) -> Ok (Source_tree_child (unquote n))
- | Some ("asset", n) -> Ok (Asset_child (unquote n))
| Some ("module", n) ->
Ok (Module_child (unquote (String.Ascii.capitalize n)))
| Some ("src", _) -> Error (`Msg "Implementation unexpected")
@@ -85,8 +83,7 @@ let resolve_parent_page resolver f =
match Resolver.lookup_page resolver p with
| Some r -> Ok r
| None -> Error (`Msg "Couldn't find specified parent page"))
- | Source_tree_child _ | Module_child _ | Asset_child _ ->
- Error (`Msg "Expecting page as parent")
+ | Module_child _ -> Error (`Msg "Expecting page as parent")
in
let extract_parent = function
| { Paths.Identifier.iv = `Page _; _ } as container -> Ok container
@@ -171,7 +168,7 @@ let root_of_compilation_unit ~parent_id ~parents_children ~hidden ~output
Filename.chop_extension Fs.File.(to_string @@ basename output)
in
String.Ascii.(uncapitalize n = uncapitalize filename)
- | Asset_child _ | Source_tree_child _ | Page_child _ -> false
+ | Page_child _ -> false
in
match parents_children with
| Some parents_children ->
@@ -215,7 +212,7 @@ let mld ~parent_id ~parents_children ~output ~children ~warnings_options input =
let page_name = PageName.make_std root_name in
let check_child = function
| Lang.Page.Page_child n -> root_name = n
- | Asset_child _ | Source_tree_child _ | Module_child _ -> false
+ | Module_child _ -> false
in
(if children = [] then
(* No children, this is a leaf page. *)
diff --git a/src/odoc/fs.ml b/src/odoc/fs.ml
index a7d78e9b81..f6a2471bd5 100644
--- a/src/odoc/fs.ml
+++ b/src/odoc/fs.ml
@@ -21,6 +21,18 @@ type directory = Fpath.t
type file = Fpath.t
+let mkdir_p dir =
+ let mkdir d =
+ try Unix.mkdir (Fpath.to_string d) 0o755 with
+ | Unix.Unix_error (Unix.EEXIST, _, _) -> ()
+ | exn -> raise exn
+ in
+ let rec dirs_to_create p acc =
+ if Sys.file_exists (Fpath.to_string p) then acc
+ else dirs_to_create (Fpath.parent p) (p :: acc)
+ in
+ List.iter (dirs_to_create dir []) ~f:mkdir
+
module File = struct
type t = file
@@ -92,6 +104,28 @@ module File = struct
Result.Error (`Msg err)
with Sys_error e -> Result.Error (`Msg e)
+ let copy ~src ~dst =
+ let with_ open_ close filename f =
+ let c = open_ (Fpath.to_string filename) in
+ Odoc_utils.Fun.protect ~finally:(fun () -> close c) (fun () -> f c)
+ in
+ let with_ic = with_ open_in_bin close_in_noerr in
+ let with_oc = with_ open_out_bin close_out_noerr in
+ try
+ with_ic src (fun ic ->
+ mkdir_p (dirname dst);
+ with_oc dst (fun oc ->
+ let len = 65536 in
+ let buf = Bytes.create len in
+ let rec loop () =
+ let read = input ic buf 0 len in
+ if read > 0 then (
+ output oc buf 0 read;
+ loop ())
+ in
+ Ok (loop ())))
+ with Sys_error e -> Result.Error (`Msg e)
+
let exists file = Sys.file_exists (Fpath.to_string file)
let rec of_segs_tl acc = function
@@ -140,17 +174,7 @@ module Directory = struct
let contains ~parentdir f = Fpath.is_rooted ~root:parentdir f
- let mkdir_p dir =
- let mkdir d =
- try Unix.mkdir (Fpath.to_string d) 0o755 with
- | Unix.Unix_error (Unix.EEXIST, _, _) -> ()
- | exn -> raise exn
- in
- let rec dirs_to_create p acc =
- if Sys.file_exists (Fpath.to_string p) then acc
- else dirs_to_create (Fpath.parent p) (p :: acc)
- in
- List.iter (dirs_to_create dir []) ~f:mkdir
+ let mkdir_p dir = mkdir_p dir
let to_string = Fpath.to_string
diff --git a/src/odoc/fs.mli b/src/odoc/fs.mli
index 09a162fcbf..30eb535545 100644
--- a/src/odoc/fs.mli
+++ b/src/odoc/fs.mli
@@ -91,6 +91,8 @@ module File : sig
val read : t -> (string, [> msg ]) result
+ val copy : src:t -> dst:t -> (unit, [> msg ]) result
+
val exists : t -> bool
val of_segs : string list -> t
diff --git a/src/odoc/html_page.ml b/src/odoc/html_page.ml
index 3d4bc2d320..01e2de2ccc 100644
--- a/src/odoc/html_page.ml
+++ b/src/odoc/html_page.ml
@@ -14,65 +14,12 @@
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*)
-open Odoc_model
+type args = { html_config : Odoc_html.Config.t }
-type args = { html_config : Odoc_html.Config.t; assets : Fpath.t list }
-
-let render { html_config; assets = _ } sidebar page =
+let render { html_config } sidebar page =
Odoc_html.Generator.render ~config:html_config ~sidebar page
-let asset_documents parent_id children asset_paths =
- let asset_names =
- Odoc_utils.List.filter_map
- (function Lang.Page.Asset_child name -> Some name | _ -> None)
- children
- in
- let rec extract paths name =
- match paths with
- | [] -> (paths, (name, None))
- | x :: xs when Fpath.basename x = name -> (xs, (name, Some x))
- | x :: xs ->
- let rest, elt = extract xs name in
- (x :: rest, elt)
- in
- let unmatched, paired_or_missing =
- let rec foldmap paths paired = function
- | [] -> (paths, paired)
- | name :: names ->
- let paths, pair = extract paths name in
- foldmap paths (pair :: paired) names
- in
- foldmap asset_paths [] asset_names
- in
- List.iter
- (fun asset ->
- Error.raise_warning
- (Error.filename_only "this asset was not declared as a child of %s"
- (Paths.Identifier.name parent_id)
- (Fs.File.to_string asset)))
- unmatched;
- Odoc_utils.List.filter_map
- (fun (name, path) ->
- match path with
- | None ->
- Error.raise_warning (Error.filename_only "asset is missing." name);
- None
- | Some path ->
- let asset_id =
- Paths.Identifier.Mk.asset_file
- (parent_id, Names.AssetName.make_std name)
- in
- let url = Odoc_document.Url.Path.from_identifier asset_id in
- Some (Odoc_document.Types.Document.Asset { url; src = path }))
- paired_or_missing
-
-let extra_documents args input =
- match input with
- | Odoc_document.Renderer.CU _unit ->
- (* Remove assets from [Document.t] and move their rendering in the main
- [render] function to allow to remove the [extra_documents]
- machinery? *)
- []
- | Page page -> asset_documents page.Lang.Page.name page.children args.assets
+let filepath { html_config } url =
+ Odoc_html.Generator.filepath ~config:html_config url
-let renderer = { Odoc_document.Renderer.name = "html"; render; extra_documents }
+let renderer = { Odoc_document.Renderer.name = "html"; render; filepath }
diff --git a/src/odoc/html_page.mli b/src/odoc/html_page.mli
index 7fe18ffb13..1688ad6b4b 100644
--- a/src/odoc/html_page.mli
+++ b/src/odoc/html_page.mli
@@ -16,6 +16,6 @@
open Odoc_document
-type args = { html_config : Odoc_html.Config.t; assets : Fpath.t list }
+type args = { html_config : Odoc_html.Config.t }
val renderer : args Renderer.t
diff --git a/src/odoc/latex.ml b/src/odoc/latex.ml
index a1b62c247f..78e1d621f5 100644
--- a/src/odoc/latex.ml
+++ b/src/odoc/latex.ml
@@ -5,6 +5,6 @@ type args = { with_children : bool }
let render args _sidebar page =
Odoc_latex.Generator.render ~with_children:args.with_children page
-let extra_documents _args _unit = []
+let filepath _args url = Odoc_latex.Generator.filepath url
-let renderer = { Renderer.name = "latex"; render; extra_documents }
+let renderer = { Renderer.name = "latex"; render; filepath }
diff --git a/src/odoc/man_page.ml b/src/odoc/man_page.ml
index 7ee8260250..95e4a26814 100644
--- a/src/odoc/man_page.ml
+++ b/src/odoc/man_page.ml
@@ -2,6 +2,6 @@ open Odoc_document
let render _ _sidebar page = Odoc_manpage.Generator.render page
-let extra_documents _args _unit = []
+let filepath _ url = Odoc_manpage.Generator.filepath url
-let renderer = { Renderer.name = "man"; render; extra_documents }
+let renderer = { Renderer.name = "man"; render; filepath }
diff --git a/src/odoc/rendering.ml b/src/odoc/rendering.ml
index a1d7a8146e..b373203b4e 100644
--- a/src/odoc/rendering.ml
+++ b/src/odoc/rendering.ml
@@ -2,46 +2,50 @@ open Odoc_document
open Or_error
open Odoc_model
-let documents_of_unit ~warnings_options ~syntax ~renderer ~extra unit =
- Error.catch_warnings (fun () ->
- renderer.Renderer.extra_documents extra (CU unit))
- |> Error.handle_warnings ~warnings_options
- >>= fun extra_docs ->
- Ok (Renderer.document_of_compilation_unit ~syntax unit :: extra_docs)
-
-let documents_of_page ~warnings_options ~syntax ~renderer ~extra page =
- Error.catch_warnings (fun () ->
- renderer.Renderer.extra_documents extra (Page page))
- |> Error.handle_warnings ~warnings_options
- >>= fun extra_docs -> Ok (Renderer.document_of_page ~syntax page :: extra_docs)
+let prepare ~extra_suffix ~output_dir filename =
+ let filename =
+ match extra_suffix with
+ | Some s -> Fpath.add_ext s filename
+ | None -> filename
+ in
+ let filename = Fpath.normalize @@ Fs.File.append output_dir filename in
+ let directory = Fs.File.dirname filename in
+ Fs.Directory.mkdir_p directory;
+ filename
-let documents_of_odocl ~warnings_options ~renderer ~extra ~syntax input =
+let document_of_odocl ~syntax input =
Odoc_file.load input >>= fun unit ->
match unit.content with
| Odoc_file.Page_content odoctree ->
- documents_of_page ~warnings_options ~syntax ~renderer ~extra odoctree
- | Impl_content _impl ->
- (* documents_of_implementation ~warnings_options ~syntax impl source *)
+ Ok (Renderer.document_of_page ~syntax odoctree)
+ | Unit_content odoctree ->
+ Ok (Renderer.document_of_compilation_unit ~syntax odoctree)
+ | Impl_content _ ->
Error
(`Msg
"Wrong kind of unit: Expected a page or module unit, got an \
implementation. Use the dedicated command for implementation.")
- | Unit_content odoctree ->
- documents_of_unit ~warnings_options ~syntax ~renderer ~extra odoctree
- | Asset_content _ -> Ok [] (* TODO *)
+ | Asset_content _ ->
+ Error
+ (`Msg
+ "Wrong kind of unit: Expected a page or module unit, got an asset \
+ unit. Use the dedicated command for assets.")
-let documents_of_input ~renderer ~extra ~resolver ~warnings_options ~syntax
- input =
+let document_of_input ~resolver ~warnings_options ~syntax input =
let output = Fs.File.(set_ext ".odocl" input) in
Odoc_link.from_odoc ~resolver ~warnings_options input output >>= function
- | `Page page -> Ok [ Renderer.document_of_page ~syntax page ]
- | `Impl _impl ->
+ | `Page page -> Ok (Renderer.document_of_page ~syntax page)
+ | `Module m -> Ok (Renderer.document_of_compilation_unit ~syntax m)
+ | `Impl _ ->
Error
(`Msg
"Wrong kind of unit: Expected a page or module unit, got an \
implementation. Use the dedicated command for implementation.")
- | `Module m -> documents_of_unit ~warnings_options ~syntax ~renderer ~extra m
- | `Asset _ -> Ok [] (* TODO *)
+ | `Asset _ ->
+ Error
+ (`Msg
+ "Wrong kind of unit: Expected a page or module unit, got an asset \
+ unit. Use the dedicated command for assets.")
let render_document renderer ~sidebar ~output:root_dir ~extra_suffix ~extra doc
=
@@ -49,7 +53,6 @@ let render_document renderer ~sidebar ~output:root_dir ~extra_suffix ~extra doc
match doc with
| Odoc_document.Types.Document.Page { url; _ } -> url
| Source_page { url; _ } -> url
- | Asset { url; _ } -> url
in
let sidebar =
Odoc_utils.Option.map
@@ -58,14 +61,7 @@ let render_document renderer ~sidebar ~output:root_dir ~extra_suffix ~extra doc
in
let pages = renderer.Renderer.render extra sidebar doc in
Renderer.traverse pages ~f:(fun filename content ->
- let filename =
- match extra_suffix with
- | Some s -> Fpath.add_ext s filename
- | None -> filename
- in
- let filename = Fpath.normalize @@ Fs.File.append root_dir filename in
- let directory = Fs.File.dirname filename in
- Fs.Directory.mkdir_p directory;
+ let filename = prepare ~extra_suffix ~output_dir:root_dir filename in
let oc = open_out (Fs.File.to_string filename) in
let fmt = Format.formatter_of_out_channel oc in
Format.fprintf fmt "%t@?" content;
@@ -74,14 +70,11 @@ let render_document renderer ~sidebar ~output:root_dir ~extra_suffix ~extra doc
let render_odoc ~resolver ~warnings_options ~syntax ~renderer ~output extra file
=
let extra_suffix = None in
- documents_of_input ~renderer ~extra ~resolver ~warnings_options ~syntax file
- >>= fun docs ->
- List.iter
- (render_document renderer ~sidebar:None ~output ~extra_suffix ~extra)
- docs;
+ document_of_input ~resolver ~warnings_options ~syntax file >>= fun doc ->
+ render_document renderer ~sidebar:None ~output ~extra_suffix ~extra doc;
Ok ()
-let generate_odoc ~syntax ~warnings_options ~renderer ~output ~extra_suffix
+let generate_odoc ~syntax ~warnings_options:_ ~renderer ~output ~extra_suffix
~sidebar extra file =
(match sidebar with
| None -> Ok None
@@ -89,11 +82,8 @@ let generate_odoc ~syntax ~warnings_options ~renderer ~output ~extra_suffix
Odoc_file.load_index x >>= fun (sidebar, _) ->
Ok (Some (Odoc_document.Sidebar.of_lang sidebar)))
>>= fun sidebar ->
- documents_of_odocl ~warnings_options ~renderer ~extra ~syntax file
- >>= fun docs ->
- List.iter
- (render_document renderer ~output ~sidebar ~extra_suffix ~extra)
- docs;
+ document_of_odocl ~syntax file >>= fun doc ->
+ render_document renderer ~output ~sidebar ~extra_suffix ~extra doc;
Ok ()
let documents_of_implementation ~warnings_options:_ ~syntax impl source_file =
@@ -128,22 +118,30 @@ let generate_source_odoc ~syntax ~warnings_options ~renderer ~output
| Page_content _ | Unit_content _ | Asset_content _ ->
Error (`Msg "Expected an implementation unit")
+let generate_asset_odoc ~warnings_options:_ ~renderer ~output ~asset_file
+ ~extra_suffix extra file =
+ Odoc_file.load file >>= fun unit ->
+ match unit.content with
+ | Odoc_file.Asset_content unit ->
+ let url = Odoc_document.Url.Path.from_identifier unit.name in
+ let filename = renderer.Renderer.filepath extra url in
+ let dst = prepare ~extra_suffix ~output_dir:output filename in
+ Fs.File.copy ~src:asset_file ~dst
+ | Page_content _ | Unit_content _ | Impl_content _ ->
+ Error (`Msg "Expected an asset unit")
+
let targets_odoc ~resolver ~warnings_options ~syntax ~renderer ~output:root_dir
~extra odoctree =
- let docs =
+ let doc =
if Fpath.get_ext odoctree = ".odoc" then
- documents_of_input ~renderer ~extra ~resolver ~warnings_options ~syntax
- odoctree
- else documents_of_odocl ~warnings_options ~renderer ~extra ~syntax odoctree
+ document_of_input ~resolver ~warnings_options ~syntax odoctree
+ else document_of_odocl ~syntax odoctree
in
- docs >>= fun docs ->
- List.iter
- (fun doc ->
- let pages = renderer.Renderer.render extra None doc in
- Renderer.traverse pages ~f:(fun filename _content ->
- let filename = Fpath.normalize @@ Fs.File.append root_dir filename in
- Format.printf "%a\n" Fpath.pp filename))
- docs;
+ doc >>= fun doc ->
+ let pages = renderer.Renderer.render extra None doc in
+ Renderer.traverse pages ~f:(fun filename _content ->
+ let filename = Fpath.normalize @@ Fs.File.append root_dir filename in
+ Format.printf "%a\n" Fpath.pp filename);
Ok ()
let targets_source_odoc ~syntax ~warnings_options ~renderer ~output:root_dir
diff --git a/src/odoc/rendering.mli b/src/odoc/rendering.mli
index c631751a6b..1d274d3c76 100644
--- a/src/odoc/rendering.mli
+++ b/src/odoc/rendering.mli
@@ -33,6 +33,16 @@ val generate_source_odoc :
Fpath.t ->
(unit, [> msg ]) result
+val generate_asset_odoc :
+ warnings_options:Odoc_model.Error.warnings_options ->
+ renderer:'a Renderer.t ->
+ output:Fs.directory ->
+ asset_file:Fs.file ->
+ extra_suffix:string option ->
+ 'a ->
+ Fs.file ->
+ (unit, [> Or_error.msg ]) result
+
val targets_odoc :
resolver:Resolver.t ->
warnings_options:Odoc_model.Error.warnings_options ->
diff --git a/src/utils/odoc_utils.ml b/src/utils/odoc_utils.ml
index 58daa04eb4..d3654cab29 100644
--- a/src/utils/odoc_utils.ml
+++ b/src/utils/odoc_utils.ml
@@ -80,3 +80,19 @@ end
module Option = struct
let map f = function None -> None | Some x -> Some (f x)
end
+
+module Fun = struct
+ exception Finally_raised of exn
+
+ let protect ~(finally : unit -> unit) work =
+ let finally_no_exn () =
+ try finally () with e -> raise (Finally_raised e)
+ in
+ match work () with
+ | result ->
+ finally_no_exn ();
+ result
+ | exception work_exn ->
+ finally_no_exn ();
+ raise work_exn
+end
diff --git a/src/xref2/link.ml b/src/xref2/link.ml
index f0291a0c35..479a7b26e3 100644
--- a/src/xref2/link.ml
+++ b/src/xref2/link.ml
@@ -1109,7 +1109,6 @@ let page env page =
List.iter
(fun child ->
match child with
- | Page.Asset_child _ | Page.Source_tree_child _ -> ()
| Page.Page_child page -> (
match Env.lookup_page_by_name page env with
| Ok _ -> ()
diff --git a/test/pages/assets.t/index.mld b/test/pages/assets.t/index.mld
deleted file mode 100644
index 4e01eac22f..0000000000
--- a/test/pages/assets.t/index.mld
+++ /dev/null
@@ -1,4 +0,0 @@
-{0 Package page}
-
-Some image:
-{%html: 
%}
diff --git a/test/pages/assets.t/run.t b/test/pages/assets.t/run.t
deleted file mode 100644
index 04816657db..0000000000
--- a/test/pages/assets.t/run.t
+++ /dev/null
@@ -1,93 +0,0 @@
-Blablabla
-
- $ cat index.mld
- {0 Package page}
-
- Some image:
- {%html: %}
-
-And we'll have a module that we'll put underneath this package page.
-
- $ cat test.mli
- (** Humpf, let's try accessing the asset:
- {%html: 
%}
- *)
-
- (** Nevermind *)
- type t
-
-
-Compile the module first
-
- $ ocamlc -c -bin-annot test.mli
-
-Then we need to odoc-compile the package mld file, listing its children
-
- $ odoc compile index.mld --child module-test --child asset-img.jpg
- Warning: Potential name clash - child page named 'index'
-
-This will have produced a file called 'page-index.odoc'.
-Now we can odoc-compile the module odoc file passing that file as parent.
-
- $ odoc compile test.cmti -I . --parent index
-
-Link and generate the HTML (forgetting the asset!):
-
- $ for i in *.odoc; do odoc link -I . $i; done
- $ for i in *.odocl; do odoc html-generate $i -o html; done
- File "img.jpg":
- Warning: asset is missing.
-
-Note that the html was generated despite the missing asset (there might be dead refs!)
-
- $ find html -type f | sort
- html/index/Test/index.html
- html/index/index.html
-
-Which matches the output of the targets command (which emits no warning):
-
- $ odoc html-targets page-index.odocl -o html
- html/index/index.html
-
-Trying to pass an asset which doesn't exist:
-(also: some sed magic due to cmdliner output changing based on the version)
-
- $ odoc html-generate page-index.odocl --asset img.jpg -o html 2>&1 | \
- > sed 's/…/.../' | sed "s/\`/'/g"
- odoc: option '--asset': no 'img.jpg' file or directory
- Usage: odoc html-generate [OPTION]... FILE.odocl
- Try 'odoc html-generate --help' or 'odoc --help' for more information.
-
-Creating then passing the asset alongside an incorrect one:
-
- $ touch img.jpg
- $ odoc html-generate page-index.odocl --asset img.jpg --asset test.mli -o html
- File "test.mli":
- Warning: this asset was not declared as a child of index
-
-This time, the asset should have been copied at the right place:
-
- $ find html -type f | sort
- html/index/Test/index.html
- html/index/img.jpg
- html/index/index.html
-
-Which once again matches the output of the targets command (still no warning!):
-
- $ odoc html-targets page-index.odocl --asset img.jpg --asset test.mli -o html
- html/index/index.html
- html/index/img.jpg
-
-Let's make sure the manpage and latex renderers "work" too
-
- $ for i in *.odocl; do odoc man-generate $i -o man; odoc latex-generate $i -o latex; done
-
- $ find man -type f | sort
- man/index.3o
- man/index/Test.3o
-
- $ find latex -type f | sort
- latex/index.tex
- latex/index/Test.tex
-
-Notice that the assets are *not* there. This should probably be fixed for the latex backend.
diff --git a/test/pages/assets.t/test.mli b/test/pages/assets.t/test.mli
deleted file mode 100644
index d329f104f8..0000000000
--- a/test/pages/assets.t/test.mli
+++ /dev/null
@@ -1,7 +0,0 @@
-(** Humpf, let's try accessing the asset:
- {%html: %}
- *)
-
-(** Nevermind *)
-type t
-
diff --git a/test/pages/new_assets.t/run.t b/test/pages/new_assets.t/run.t
index 6341bb6e03..01bde99fe9 100644
--- a/test/pages/new_assets.t/run.t
+++ b/test/pages/new_assets.t/run.t
@@ -10,3 +10,13 @@
},
"root": ""
}
+
+ $ echo "Hello!" > img.png
+
+ $ odoc html-generate-asset --output-dir _html --asset-unit odoc/root/test/asset-img.png.odoc img.png
+
+ $ find _html -name img.png
+ _html/root/test/img.png
+
+ $ cat $(find _html -name img.png)
+ Hello!
diff --git a/test/sources/include_in_expansion.t/run.t b/test/sources/include_in_expansion.t/run.t
index f3732716e0..24b87d70d1 100644
--- a/test/sources/include_in_expansion.t/run.t
+++ b/test/sources/include_in_expansion.t/run.t
@@ -1,6 +1,6 @@
Checking that source parents are kept, using include.
- $ odoc compile -c module-a -c srctree-source root.mld
+ $ odoc compile -c module-a root.mld
$ ocamlc -c -o b.cmo b.ml -bin-annot -I .
$ ocamlc -c -o main__A.cmo a.ml -bin-annot -I .
@@ -20,7 +20,7 @@ Checking that source parents are kept, using include.
$ odoc html-generate-source --impl impl-main.odocl --indent -o html main.ml
$ odoc html-generate --indent -o html main.odocl
- $ odoc html-generate-source --impl impl-main__A.odocl --hidden --indent -o html a.ml
+ $ odoc html-generate-source --impl impl-main__A.odocl --indent -o html a.ml
$ odoc html-generate --hidden --indent -o html main__A.odocl
In Main.A, the source parent of value x should be to Main__A, while the
diff --git a/test/sources/recursive_module.t/run.t b/test/sources/recursive_module.t/run.t
index a021e57f69..f8e0b51890 100644
--- a/test/sources/recursive_module.t/run.t
+++ b/test/sources/recursive_module.t/run.t
@@ -6,11 +6,7 @@ Checking that source links exists inside recursive modules.
$ odoc link -I . impl-main.odoc
$ odoc link -I . main.odoc
$ odoc html-generate --indent -o html main.odocl
- $ odoc html-generate-impl --source main.ml --indent -o html impl-main.odocl
- odoc: unknown command 'html-generate-impl', must be one of 'aggregate-occurrences', 'classify', 'compile', 'compile-asset', 'compile-deps', 'compile-impl', 'compile-index', 'compile-targets', 'count-occurrences', 'css', 'errors', 'html', 'html-deps', 'html-fragment', 'html-generate', 'html-generate-source', 'html-targets', 'html-targets-source', 'html-url', 'latex', 'latex-generate', 'latex-targets', 'latex-url', 'link', 'link-deps', 'man', 'man-generate', 'man-targets', 'support-files' or 'support-files-targets'.
- Usage: odoc [COMMAND] …
- Try 'odoc --help' for more information.
- [2]
+ $ odoc html-generate-source --impl impl-main.odocl --indent -o html main.ml
Both modules should contain source links