diff --git a/src/document/renderer.ml b/src/document/renderer.ml
index cee635dab6..f69847f67a 100644
--- a/src/document/renderer.ml
+++ b/src/document/renderer.ml
@@ -17,14 +17,14 @@ let traverse ~f t =
in
List.iter aux t
+type input =
+ | CU of Odoc_model.Lang.Compilation_unit.t
+ | Page of Odoc_model.Lang.Page.t
+
type 'a t = {
name : string;
render : 'a -> Types.Document.t -> page list;
- extra_documents :
- 'a ->
- Odoc_model.Lang.Compilation_unit.t ->
- syntax:syntax ->
- Types.Document.t list;
+ extra_documents : 'a -> input -> syntax:syntax -> Types.Document.t list;
}
let document_of_page ~syntax v =
diff --git a/src/document/types.ml b/src/document/types.ml
index a40c78b087..2053ce902e 100644
--- a/src/document/types.ml
+++ b/src/document/types.ml
@@ -192,8 +192,13 @@ 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
+ type t = Page of Page.t | Source_page of Source_page.t | Asset of Asset.t
end
let inline ?(attr = []) desc = Inline.{ attr; desc }
diff --git a/src/document/url.ml b/src/document/url.ml
index 3be65243d3..fdd135a486 100644
--- a/src/document/url.ml
+++ b/src/document/url.ml
@@ -87,10 +87,13 @@ module Path = struct
| Identifier.Signature.t_pv
| Identifier.ClassSignature.t_pv ]
- type source_pv =
- [ nonsrc_pv | Identifier.SourcePage.t_pv | Identifier.SourceDir.t_pv ]
+ type any_pv =
+ [ nonsrc_pv
+ | Identifier.SourcePage.t_pv
+ | Identifier.SourceDir.t_pv
+ | Identifier.AssetFile.t_pv ]
- and source = source_pv Odoc_model.Paths.Identifier.id
+ and any = any_pv Odoc_model.Paths.Identifier.id
type kind =
[ `Module
@@ -120,13 +123,13 @@ module Path = struct
let mk ?parent kind name = { kind; parent; name }
- let rec from_identifier : source -> t =
+ let rec from_identifier : any -> t =
fun x ->
match x with
| { iv = `Root (parent, unit_name); _ } ->
let parent =
match parent with
- | Some p -> Some (from_identifier (p :> source))
+ | Some p -> Some (from_identifier (p :> any))
| None -> None
in
let kind = `Module in
@@ -135,7 +138,7 @@ module Path = struct
| { iv = `Page (parent, page_name); _ } ->
let parent =
match parent with
- | Some p -> Some (from_identifier (p :> source))
+ | Some p -> Some (from_identifier (p :> any))
| None -> None
in
let kind = `Page in
@@ -144,48 +147,51 @@ module Path = struct
| { iv = `LeafPage (parent, page_name); _ } ->
let parent =
match parent with
- | Some p -> Some (from_identifier (p :> source))
+ | Some p -> Some (from_identifier (p :> any))
| None -> None
in
let kind = `LeafPage in
let name = PageName.to_string page_name in
mk ?parent kind name
| { iv = `Module (parent, mod_name); _ } ->
- let parent = from_identifier (parent :> source) in
+ let parent = from_identifier (parent :> any) in
let kind = `Module in
let name = ModuleName.to_string mod_name in
mk ~parent kind name
| { iv = `Parameter (functor_id, arg_name); _ } as p ->
- let parent = from_identifier (functor_id :> source) in
+ let parent = from_identifier (functor_id :> any) in
let arg_num = functor_arg_pos p in
let kind = `Parameter arg_num in
let name = ModuleName.to_string arg_name in
mk ~parent kind name
| { iv = `ModuleType (parent, modt_name); _ } ->
- let parent = from_identifier (parent :> source) in
+ let parent = from_identifier (parent :> any) in
let kind = `ModuleType in
let name = ModuleTypeName.to_string modt_name in
mk ~parent kind name
| { iv = `Class (parent, name); _ } ->
- let parent = from_identifier (parent :> source) in
+ let parent = from_identifier (parent :> any) in
let kind = `Class in
let name = ClassName.to_string name in
mk ~parent kind name
| { iv = `ClassType (parent, name); _ } ->
- let parent = from_identifier (parent :> source) in
+ let parent = from_identifier (parent :> any) in
let kind = `ClassType in
let name = ClassTypeName.to_string name in
mk ~parent kind name
- | { iv = `Result p; _ } -> from_identifier (p :> source)
+ | { iv = `Result p; _ } -> from_identifier (p :> any)
| { iv = `SourceDir (parent, name); _ }
| { iv = `SourcePage (parent, name); _ } ->
- let parent = from_identifier (parent :> source) in
+ let parent = from_identifier (parent :> any) in
let kind = `Page in
mk ~parent kind name
+ | { iv = `AssetFile (parent, name); _ } ->
+ let parent = from_identifier (parent :> any) in
+ let kind = `File in
+ mk ~parent kind name
let from_identifier p =
- from_identifier
- (p : [< source_pv ] Odoc_model.Paths.Identifier.id :> source)
+ from_identifier (p : [< any_pv ] Odoc_model.Paths.Identifier.id :> any)
let to_list url =
let rec loop acc { parent; name; kind } =
@@ -266,7 +272,7 @@ module Anchor = struct
let open Error in
function
| { iv = `Module (parent, mod_name); _ } ->
- let parent = Path.from_identifier (parent :> Path.source) in
+ let parent = Path.from_identifier (parent :> Path.any) in
let kind = `Module in
let anchor =
Printf.sprintf "%s-%s" (Path.string_of_kind kind)
@@ -274,13 +280,13 @@ module Anchor = struct
in
Ok { page = parent; anchor; kind }
| { iv = `Root _; _ } as p ->
- let page = Path.from_identifier (p :> Path.source) in
+ let page = Path.from_identifier (p :> Path.any) in
Ok { page; kind = `Module; anchor = "" }
| { iv = `Page _; _ } as p ->
- let page = Path.from_identifier (p :> Path.source) in
+ let page = Path.from_identifier (p :> Path.any) in
Ok { page; kind = `Page; anchor = "" }
| { iv = `LeafPage _; _ } as p ->
- let page = Path.from_identifier (p :> Path.source) in
+ let page = Path.from_identifier (p :> Path.any) in
Ok { page; kind = `LeafPage; anchor = "" }
(* For all these identifiers, page names and anchors are the same *)
| {
@@ -289,7 +295,7 @@ module Anchor = struct
} as p ->
Ok (anchorify_path @@ Path.from_identifier p)
| { iv = `Type (parent, type_name); _ } ->
- let page = Path.from_identifier (parent :> Path.source) in
+ let page = Path.from_identifier (parent :> Path.any) in
let kind = `Type in
Ok
{
@@ -302,7 +308,7 @@ module Anchor = struct
| { iv = `CoreType ty_name; _ } ->
Error (Not_linkable ("core_type:" ^ TypeName.to_string ty_name))
| { iv = `Extension (parent, name); _ } ->
- let page = Path.from_identifier (parent :> Path.source) in
+ let page = Path.from_identifier (parent :> Path.any) in
let kind = `Extension in
Ok
{
@@ -313,7 +319,7 @@ module Anchor = struct
kind;
}
| { iv = `Exception (parent, name); _ } ->
- let page = Path.from_identifier (parent :> Path.source) in
+ let page = Path.from_identifier (parent :> Path.any) in
let kind = `Exception in
Ok
{
@@ -326,7 +332,7 @@ module Anchor = struct
| { iv = `CoreException name; _ } ->
Error (Not_linkable ("core_exception:" ^ ExceptionName.to_string name))
| { iv = `Value (parent, name); _ } ->
- let page = Path.from_identifier (parent :> Path.source) in
+ let page = Path.from_identifier (parent :> Path.any) in
let kind = `Val in
Ok
{
@@ -337,13 +343,13 @@ module Anchor = struct
}
| { iv = `Method (parent, name); _ } ->
let str_name = MethodName.to_string name in
- let page = Path.from_identifier (parent :> Path.source) in
+ let page = Path.from_identifier (parent :> Path.any) in
let kind = `Method in
Ok
{ page; anchor = Format.asprintf "%a-%s" pp_kind kind str_name; kind }
| { iv = `InstanceVariable (parent, name); _ } ->
let str_name = InstanceVariableName.to_string name in
- let page = Path.from_identifier (parent :> Path.source) in
+ let page = Path.from_identifier (parent :> Path.any) in
let kind = `Val in
Ok
{ page; anchor = Format.asprintf "%a-%s" pp_kind kind str_name; kind }
@@ -367,16 +373,19 @@ module Anchor = struct
Error (Unexpected_anchor "core_type label parent")
| { iv = `Type (gp, _); _ } -> mk ~kind:`Section gp str_name
| { iv = #Path.nonsrc_pv; _ } as p ->
- mk ~kind:`Section (p :> Path.source) str_name)
+ mk ~kind:`Section (p :> Path.any) str_name)
| { iv = `SourceLocation (parent, loc); _ } ->
- let page = Path.from_identifier (parent :> Path.source) in
+ let page = Path.from_identifier (parent :> Path.any) in
Ok { page; kind = `SourceAnchor; anchor = DefName.to_string loc }
| { iv = `SourceLocationMod parent; _ } ->
- let page = Path.from_identifier (parent :> Path.source) in
+ let page = Path.from_identifier (parent :> Path.any) in
Ok { page; kind = `SourceAnchor; anchor = "" }
- | { iv = `SourcePage (p, _name); _ } | { iv = `SourceDir (p, _name); _ } ->
- let page = Path.from_identifier (p :> Path.source) in
+ | { iv = `SourcePage _ | `SourceDir _; _ } as p ->
+ let page = Path.from_identifier (p :> Path.any) in
Ok { page; kind = `Page; anchor = "" }
+ | { iv = `AssetFile _; _ } as p ->
+ let page = Path.from_identifier p in
+ Ok { page; kind = `File; anchor = "" }
let polymorphic_variant ~type_ident elt =
let name_of_type_constr te =
@@ -403,7 +412,7 @@ module Anchor = struct
(** The anchor looks like
[extension-decl-"Path.target_type"-FirstConstructor]. *)
let extension_decl (decl : Odoc_model.Lang.Extension.t) =
- let page = Path.from_identifier (decl.parent :> Path.source) in
+ let page = Path.from_identifier (decl.parent :> Path.any) in
let kind = `ExtensionDecl in
let first_cons = Identifier.name (List.hd decl.constructors).id in
let anchor = Format.asprintf "%a-%s" pp_kind kind first_cons in
@@ -420,7 +429,7 @@ let from_path page =
{ Anchor.page; anchor = ""; kind = (page.kind :> Anchor.kind) }
let from_identifier ~stop_before = function
- | { Odoc_model.Paths.Identifier.iv = #Path.source_pv; _ } as p
+ | { Odoc_model.Paths.Identifier.iv = #Path.any_pv; _ } as p
when not stop_before ->
Ok (from_path @@ Path.from_identifier p)
| p -> Anchor.from_identifier p
diff --git a/src/document/url.mli b/src/document/url.mli
index 10bc88fa32..539da979d6 100644
--- a/src/document/url.mli
+++ b/src/document/url.mli
@@ -29,17 +29,17 @@ module Path : sig
type t = { kind : kind; parent : t option; name : string }
- type nonsrc_pv =
+ type any_pv =
[ Identifier.Page.t_pv
| Identifier.Signature.t_pv
- | Identifier.ClassSignature.t_pv ]
+ | Identifier.ClassSignature.t_pv
+ | Identifier.SourcePage.t_pv
+ | Identifier.SourceDir.t_pv
+ | Identifier.AssetFile.t_pv ]
- type source_pv =
- [ nonsrc_pv | Identifier.SourcePage.t_pv | Identifier.SourceDir.t_pv ]
+ and any = any_pv Odoc_model.Paths.Identifier.id
- and source = source_pv Odoc_model.Paths.Identifier.id
-
- val from_identifier : [< source_pv ] Odoc_model.Paths.Identifier.id -> t
+ val from_identifier : [< any_pv ] Odoc_model.Paths.Identifier.id -> t
val to_list : t -> (kind * string) list
diff --git a/src/html/generator.ml b/src/html/generator.ml
index 215bb22cd2..aca2d5d401 100644
--- a/src/html/generator.ml
+++ b/src/html/generator.ml
@@ -503,11 +503,32 @@ 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 = function
| Document.Page page -> [ Page.page ~config page ]
| Source_page src -> [ Page.source_page ~config src ]
+ | Asset asset -> [ Page.asset ~config asset ]
let doc ~config ~xref_base_uri b =
let resolve = Link.Base xref_base_uri in
diff --git a/src/latex/generator.ml b/src/latex/generator.ml
index 83c00a9587..db5d7a3030 100644
--- a/src/latex/generator.ml
+++ b/src/latex/generator.ml
@@ -489,4 +489,4 @@ end
let render ~with_children = function
| Document.Page page -> [ Page.page ~with_children page ]
- | Source_page _ -> []
+ | Source_page _ | Asset _ -> []
diff --git a/src/manpage/generator.ml b/src/manpage/generator.ml
index c23979863a..ccb98f618e 100644
--- a/src/manpage/generator.ml
+++ b/src/manpage/generator.ml
@@ -562,4 +562,4 @@ and render_page (p : Page.t) =
let render = function
| Document.Page page -> [ render_page page ]
- | Source_page _ -> []
+ | Source_page _ | Asset _ -> []
diff --git a/src/model/lang.ml b/src/model/lang.ml
index 7b6b1e1345..962de3df42 100644
--- a/src/model/lang.ml
+++ b/src/model/lang.ml
@@ -497,6 +497,7 @@ module rec Page : sig
| Page_child of string
| Module_child of string
| Source_tree_child of string
+ | Asset_child of string
type t = {
name : Identifier.Page.t;
diff --git a/src/model/paths.ml b/src/model/paths.ml
index 555fa3454a..2c55144609 100644
--- a/src/model/paths.ml
+++ b/src/model/paths.ml
@@ -55,6 +55,7 @@ module Identifier = struct
| `SourceDir (_, name) -> name
| `SourceLocation (_, anchor) -> DefName.to_string anchor
| `SourceLocationMod x -> name_aux (x :> t)
+ | `AssetFile (_, name) -> name
let name : [< t_pv ] id -> string = fun n -> name_aux (n :> t)
@@ -282,6 +283,11 @@ module Identifier = struct
type t_pv = Paths_types.Identifier.source_location_pv
end
+ module AssetFile = struct
+ type t = Id.asset_file
+ type t_pv = Id.asset_file_pv
+ end
+
module OdocId = struct
type t = Id.odoc_id
type t_pv = Id.odoc_id_pv
@@ -372,6 +378,9 @@ module Identifier = struct
[> `LeafPage of ContainerPage.t option * PageName.t ] id =
mk_parent_opt PageName.to_string "lp" (fun (p, n) -> `LeafPage (p, n))
+ let asset_file : Page.t * string -> AssetFile.t =
+ mk_parent (fun k -> k) "asset" (fun (p, n) -> `AssetFile (p, n))
+
let source_page (container_page, path) =
let rec source_dir dir =
match dir with
diff --git a/src/model/paths.mli b/src/model/paths.mli
index d301110433..92368846f9 100644
--- a/src/model/paths.mli
+++ b/src/model/paths.mli
@@ -143,6 +143,11 @@ module Identifier : sig
type t_pv = Id.source_location_pv
end
+ module AssetFile : sig
+ type t = Id.asset_file
+ type t_pv = Id.asset_file_pv
+ end
+
module OdocId : sig
type t = Id.odoc_id
type t_pv = Id.odoc_id_pv
@@ -219,6 +224,8 @@ module Identifier : sig
val source_page : ContainerPage.t * string list -> SourcePage.t
+ val asset_file : Page.t * string -> AssetFile.t
+
val root :
ContainerPage.t option * ModuleName.t ->
[> `Root of ContainerPage.t option * ModuleName.t ] id
diff --git a/src/model/paths_types.ml b/src/model/paths_types.ml
index e1579c8956..026605b6d8 100644
--- a/src/model/paths_types.ml
+++ b/src/model/paths_types.ml
@@ -32,6 +32,14 @@ module Identifier = struct
type source_page = source_page_pv id
(** @canonical Odoc_model.Paths.Identifier.SourcePage.t *)
+ type asset_file_pv = [ `AssetFile of page * string ]
+ (** The second argument is the filename.
+
+ @canonical Odoc_model.Paths.Identifier.AssetFile.t_pv *)
+
+ type asset_file = asset_file_pv id
+ (** @canonical Odoc_model.Paths.Identifier.AssetFile.t *)
+
type source_location_pv =
[ `SourceLocationMod of source_page
| `SourceLocation of source_page * DefName.t ]
@@ -214,7 +222,11 @@ module Identifier = struct
(** @canonical Odoc_model.Paths.Identifier.NonSrc.t *)
type any_pv =
- [ non_src_pv | source_page_pv | source_dir_pv | source_location_pv ]
+ [ non_src_pv
+ | source_page_pv
+ | source_dir_pv
+ | source_location_pv
+ | asset_file_pv ]
(** @canonical Odoc_model.Paths.Identifier.t_pv *)
and any = any_pv id
diff --git a/src/model_desc/paths_desc.ml b/src/model_desc/paths_desc.ml
index fc8cd70c9c..0719ca910a 100644
--- a/src/model_desc/paths_desc.ml
+++ b/src/model_desc/paths_desc.ml
@@ -74,6 +74,8 @@ module General_paths = struct
( "`LeafPage",
((parent :> id_t option), name),
Pair (Option identifier, Names.pagename) )
+ | `AssetFile (parent, name) ->
+ C ("`AssetFile", ((parent :> id_t), name), Pair (identifier, string))
| `Root (parent, name) ->
C
( "`Root",
diff --git a/src/odoc/bin/main.ml b/src/odoc/bin/main.ml
index 657e607006..0631d87ae4 100644
--- a/src/odoc/bin/main.ml
+++ b/src/odoc/bin/main.ml
@@ -706,19 +706,27 @@ module Odoc_html_args = struct
& opt (some convert_fpath) None
& info [ "source" ] ~doc ~docv:"file.ml")
+ 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 flat
- as_json source_file =
+ as_json source_file assets =
let open_details = not closed_details in
let html_config =
Odoc_html.Config.v ~theme_uri ~support_uri ~semantic_uris ~indent ~flat
~open_details ~as_json ()
in
- { Html_page.html_config; source_file }
+ { Html_page.html_config; source_file; assets }
in
Term.(
const config $ semantic_uris $ closed_details $ indent $ theme_uri
- $ support_uri $ flat $ as_json $ source_file)
+ $ support_uri $ flat $ as_json $ source_file $ assets)
end
module Odoc_html = Make_renderer (Odoc_html_args)
diff --git a/src/odoc/compile.ml b/src/odoc/compile.ml
index 198382101d..faed378614 100644
--- a/src/odoc/compile.ml
+++ b/src/odoc/compile.ml
@@ -50,9 +50,11 @@ let is_module_name n = String.length n > 0 && Char.Ascii.is_upper n.[0]
(** Accepted child references:
- - [page-foo] child is a container or leaf page.
+ - [asset-foo] child is an arbitrary asset
- [module-Foo] child is a module.
- [module-foo], [Foo] child is a module, for backward compatibility.
+ - [page-foo] child is a container or leaf page.
+ - [src-foo] child is a source tree
Parses [...-"foo"] as [...-foo] for backward compatibility. *)
let parse_parent_child_reference s =
@@ -65,6 +67,7 @@ let parse_parent_child_reference s =
match String.cut ~sep:"-" s with
| Some ("page", n) -> Ok (Lang.Page.Page_child (unquote n))
| Some ("src", 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 (k, _) -> Error (`Msg ("Unrecognized kind: " ^ k))
@@ -76,7 +79,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 _ ->
+ | Source_tree_child _ | Module_child _ | Asset_child _ ->
Error (`Msg "Expecting page as parent")
in
let extract_parent = function
@@ -190,7 +193,7 @@ let root_of_compilation_unit ~parent_spec ~hidden ~output ~module_name ~digest =
let check_child = function
| Lang.Page.Module_child n ->
String.Ascii.(uncapitalize n = uncapitalize filename)
- | Source_tree_child _ | Page_child _ -> false
+ | Asset_child _ | Source_tree_child _ | Page_child _ -> false
in
match parent_spec with
| Noparent -> result None
@@ -237,7 +240,7 @@ let mld ~parent_spec ~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
- | Source_tree_child _ | Module_child _ -> false
+ | Asset_child _ | Source_tree_child _ | Module_child _ -> false
in
(if children = [] then
(* No children, this is a leaf page. *)
diff --git a/src/odoc/html_page.ml b/src/odoc/html_page.ml
index 25a95c08da..29a58b822a 100644
--- a/src/odoc/html_page.ml
+++ b/src/odoc/html_page.ml
@@ -16,13 +16,17 @@
open Odoc_model
-type args = { html_config : Odoc_html.Config.t; source_file : Fpath.t option }
+type args = {
+ html_config : Odoc_html.Config.t;
+ source_file : Fpath.t option;
+ assets : Fpath.t list;
+}
-let render { html_config; source_file = _ } page =
+let render { html_config; source_file = _; assets = _ } page =
Odoc_html.Generator.render ~config:html_config page
-let extra_documents args unit ~syntax =
- match (unit.Lang.Compilation_unit.source_info, args.source_file) with
+let source_documents source_info source_file ~syntax =
+ match (source_info, source_file) with
| Some { Lang.Source_info.id; infos }, Some src -> (
match Fs.File.read src with
| Error (`Msg msg) ->
@@ -54,4 +58,59 @@ let extra_documents args unit ~syntax =
[]
| None, None -> []
+let list_filter_map f lst =
+ List.rev
+ @@ List.fold_left
+ (fun acc x -> match f x with None -> acc | Some x -> x :: acc)
+ [] lst
+
+let asset_documents parent_id children asset_paths =
+ let asset_names =
+ 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;
+ 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, 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 ~syntax =
+ match input with
+ | Odoc_document.Renderer.CU unit ->
+ source_documents unit.Lang.Compilation_unit.source_info args.source_file
+ ~syntax
+ | Page page -> asset_documents page.Lang.Page.name page.children args.assets
+
let renderer = { Odoc_document.Renderer.name = "html"; render; extra_documents }
diff --git a/src/odoc/html_page.mli b/src/odoc/html_page.mli
index 77a399d7a8..c2747cfb61 100644
--- a/src/odoc/html_page.mli
+++ b/src/odoc/html_page.mli
@@ -16,6 +16,10 @@
open Odoc_document
-type args = { html_config : Odoc_html.Config.t; source_file : Fpath.t option }
+type args = {
+ html_config : Odoc_html.Config.t;
+ source_file : Fpath.t option;
+ assets : Fpath.t list;
+}
val renderer : args Renderer.t
diff --git a/src/odoc/rendering.ml b/src/odoc/rendering.ml
index 9ae308620d..6325a63f2e 100644
--- a/src/odoc/rendering.ml
+++ b/src/odoc/rendering.ml
@@ -3,20 +3,24 @@ open Or_error
let documents_of_unit ~warnings_options ~syntax ~renderer ~extra unit =
Odoc_model.Error.catch_warnings (fun () ->
- renderer.Renderer.extra_documents ~syntax extra unit)
+ renderer.Renderer.extra_documents ~syntax extra (CU unit))
|> Odoc_model.Error.handle_warnings ~warnings_options
>>= fun extra_docs ->
- let main_doc =
- if unit.hidden then []
- else [ Renderer.document_of_compilation_unit ~syntax unit ]
- in
- Ok (main_doc @ extra_docs)
+ Ok
+ (if unit.hidden then extra_docs
+ else Renderer.document_of_compilation_unit ~syntax unit :: extra_docs)
+
+let documents_of_page ~warnings_options ~syntax ~renderer ~extra page =
+ Odoc_model.Error.catch_warnings (fun () ->
+ renderer.Renderer.extra_documents ~syntax extra (Page page))
+ |> Odoc_model.Error.handle_warnings ~warnings_options
+ >>= fun extra_docs -> Ok (Renderer.document_of_page ~syntax page :: extra_docs)
let documents_of_odocl ~warnings_options ~renderer ~extra ~syntax input =
Odoc_file.load input >>= fun unit ->
match unit.content with
| Odoc_file.Page_content odoctree ->
- Ok [ Renderer.document_of_page ~syntax odoctree ]
+ documents_of_page ~warnings_options ~syntax ~renderer ~extra odoctree
| Source_tree_content srctree ->
Ok (Renderer.documents_of_source_tree ~syntax srctree)
| Unit_content (odoctree, _) ->
diff --git a/src/odoc/source_tree.ml b/src/odoc/source_tree.ml
index dbf736ee52..7682cea9b6 100644
--- a/src/odoc/source_tree.ml
+++ b/src/odoc/source_tree.ml
@@ -7,7 +7,7 @@ module Id = Paths.Identifier
let check_is_child_of_parent siblings root_name =
let check_child = function
| Lang.Page.Source_tree_child n -> root_name = n
- | Page_child _ | Module_child _ -> false
+ | Page_child _ | Asset_child _ | Module_child _ -> false
in
if List.exists check_child siblings then Ok ()
else Error (`Msg "Specified parent is not a parent of this file")
diff --git a/src/xref2/component.ml b/src/xref2/component.ml
index 5034b92835..0cb73ac0f4 100644
--- a/src/xref2/component.ml
+++ b/src/xref2/component.ml
@@ -1258,6 +1258,10 @@ module Fmt = struct
| `SourceLocationMod p ->
Format.fprintf ppf "%a#" model_identifier
(p :> Odoc_model.Paths.Identifier.t)
+ | `AssetFile (p, name) ->
+ Format.fprintf ppf "%a/%s" model_identifier
+ (p :> Odoc_model.Paths.Identifier.t)
+ name
and model_fragment ppf (f : Odoc_model.Paths.Fragment.t) =
match f with
diff --git a/src/xref2/link.ml b/src/xref2/link.ml
index dffdd2fc26..1a229af651 100644
--- a/src/xref2/link.ml
+++ b/src/xref2/link.ml
@@ -1046,7 +1046,7 @@ let page env page =
| None -> Errors.report ~what `Lookup
in
match child with
- | Page.Source_tree_child _ -> ()
+ | Page.Asset_child _ | Page.Source_tree_child _ -> ()
| Page.Page_child page ->
check_resolves ~what:(`Child_page page) Env.lookup_page page
| Page.Module_child mod_ ->
diff --git a/test/pages/assets.t/index.mld b/test/pages/assets.t/index.mld
new file mode 100644
index 0000000000..4e01eac22f
--- /dev/null
+++ b/test/pages/assets.t/index.mld
@@ -0,0 +1,4 @@
+{0 Package page}
+
+Some image:
+{%html: 
%}
diff --git a/test/pages/assets.t/run.t b/test/pages/assets.t/run.t
new file mode 100644
index 0000000000..89439be4cb
--- /dev/null
+++ b/test/pages/assets.t/run.t
@@ -0,0 +1,92 @@
+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
+
+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
new file mode 100644
index 0000000000..d329f104f8
--- /dev/null
+++ b/test/pages/assets.t/test.mli
@@ -0,0 +1,7 @@
+(** Humpf, let's try accessing the asset:
+ {%html: %}
+ *)
+
+(** Nevermind *)
+type t
+