diff --git a/src/html/generator.ml b/src/html/generator.ml index 91cbd3884c..319bbf2757 100644 --- a/src/html/generator.ml +++ b/src/html/generator.ml @@ -368,24 +368,27 @@ module Page = struct | `Closed | `Open | `Default -> None | `Inline -> Some 0 ) - let rec include_ ?theme_uri { Subpage.content; _ } = - [ page ?theme_uri content ] + let rec include_ ?theme_uri indent { Subpage.content; _ } = + [ page ?theme_uri indent content ] - and subpages ?theme_uri i = - Utils.list_concat_map ~f:(include_ ?theme_uri) @@ Doctree.Subpages.compute i + and subpages ?theme_uri indent i = + Utils.list_concat_map ~f:(include_ ?theme_uri indent) + @@ Doctree.Subpages.compute i - and page ?theme_uri ({ Page.title; header; items = i; url } as p) = + and page ?theme_uri indent ({ Page.title; header; items = i; url } as p) = let resolve = Link.Current url in let i = Doctree.Shift.compute ~on_sub i in let toc = Toc.from_items ~resolve ~path:url i in - let subpages = subpages ?theme_uri p in + let subpages = subpages ?theme_uri indent p in let header = items ~resolve header in let content = (items ~resolve i :> any Html.elt list) in - let page = Tree.make ?theme_uri ~header ~toc ~url title content subpages in + let page = + Tree.make ?theme_uri ~indent ~header ~toc ~url title content subpages + in page end -let render ?theme_uri page = Page.page ?theme_uri page +let render ?theme_uri ~indent page = Page.page ?theme_uri indent page let doc ~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 d579a29d53..121388401c 100644 --- a/src/html/generator.mli +++ b/src/html/generator.mli @@ -1,6 +1,6 @@ open Odoc_document -val render : ?theme_uri:Tree.uri -> Types.Page.t -> Renderer.page +val render : ?theme_uri:Tree.uri -> indent:bool -> Types.Page.t -> Renderer.page val doc : xref_base_uri:string -> diff --git a/src/html/tree.ml b/src/html/tree.ml index fe1bd1d546..3afb4997e7 100644 --- a/src/html/tree.ml +++ b/src/html/tree.ml @@ -114,10 +114,10 @@ let page_creator ?(theme_uri = Relative "./") ~url name header toc content = in Html.html head (Html.body body) -let make ?theme_uri ~url ~header ~toc title content children = +let make ?theme_uri ~indent ~url ~header ~toc title content children = let filename = Link.Path.as_filename url in let html = page_creator ?theme_uri ~url title header toc content in - let content ppf = (Html.pp ()) ppf html in + let content ppf = (Html.pp ~indent ()) ppf html in { Odoc_document.Renderer.filename; content; children } let open_details = ref true diff --git a/src/html/tree.mli b/src/html/tree.mli index d927d51d21..b48010c0d5 100644 --- a/src/html/tree.mli +++ b/src/html/tree.mli @@ -29,6 +29,7 @@ type uri = val make : ?theme_uri:uri -> + indent:bool -> url:Url.Path.t -> header:Html_types.flow5_without_header_footer Html.elt list -> toc:Html_types.flow5 Html.elt list -> diff --git a/src/odoc/bin/main.ml b/src/odoc/bin/main.ml index 6552e611aa..ca094c773e 100644 --- a/src/odoc/bin/main.ml +++ b/src/odoc/bin/main.ml @@ -377,6 +377,10 @@ module Odoc_html = Make_renderer (struct in Arg.(value & flag (info ~doc [ "closed-details" ])) + let indent = + let doc = "Format the output HTML files with indentation" in + Arg.(value & flag (info ~doc [ "indent" ])) + (* Very basic validation and normalization for URI paths. *) let convert_uri : Odoc_html.Tree.uri Arg.converter = let parser str = @@ -409,10 +413,10 @@ module Odoc_html = Make_renderer (struct value & opt convert_uri default & info ~docv:"URI" ~doc [ "theme-uri" ]) let extra_args = - let f semantic_uris closed_details theme_uri = - { Html_page.semantic_uris; closed_details; theme_uri } + let f semantic_uris closed_details indent theme_uri = + { Html_page.semantic_uris; closed_details; theme_uri; indent } in - Term.(const f $ semantic_uris $ closed_details $ theme_uri) + Term.(const f $ semantic_uris $ closed_details $ indent $ theme_uri) end) module Html_fragment : sig diff --git a/src/odoc/html_page.ml b/src/odoc/html_page.ml index 12e0e1717c..fb5c011268 100644 --- a/src/odoc/html_page.ml +++ b/src/odoc/html_page.ml @@ -19,13 +19,14 @@ open Odoc_document type args = { semantic_uris : bool; closed_details : bool; + indent : bool; theme_uri : Odoc_html.Tree.uri; } let render args page = Odoc_html.Link.semantic_uris := args.semantic_uris; Odoc_html.Tree.open_details := not args.closed_details; - Odoc_html.Generator.render ~theme_uri:args.theme_uri page + Odoc_html.Generator.render ~theme_uri:args.theme_uri ~indent:args.indent page let files_of_url url = [ Odoc_html.Link.Path.as_filename url ] diff --git a/src/odoc/html_page.mli b/src/odoc/html_page.mli index 432ccaefb9..e3471a6404 100644 --- a/src/odoc/html_page.mli +++ b/src/odoc/html_page.mli @@ -19,6 +19,7 @@ open Odoc_document type args = { semantic_uris : bool; closed_details : bool; + indent : bool; theme_uri : Odoc_html.Tree.uri; } diff --git a/src/xref2/compile.ml b/src/xref2/compile.ml index 53d0da042f..914fa28e12 100644 --- a/src/xref2/compile.ml +++ b/src/xref2/compile.ml @@ -64,7 +64,7 @@ and content env id = | Module m -> let sg = Type_of.signature env m in Module (signature env (id :> Id.Signature.t) sg) - | Pack _ -> failwith "Unhandled content" + | Pack p -> Pack p and value_ env parent t = let open Value in diff --git a/src/xref2/env.ml b/src/xref2/env.ml index 4c4afee520..b0a8cb1792 100644 --- a/src/xref2/env.ml +++ b/src/xref2/env.ml @@ -346,7 +346,19 @@ let module_of_unit : Odoc_model.Lang.Compilation_unit.t -> Component.Module.t = in let ty = Component.Of_Lang.(module_ empty m) in ty - | Pack _ -> failwith "Unsupported" + | Pack _p -> + let m = + Odoc_model.Lang.Module. + { + id = (unit.id :> Odoc_model.Paths.Identifier.Module.t); + doc = unit.doc; + type_ = ModuleType (Signature []); + canonical = None; + hidden = unit.hidden; + } + in + let ty = Component.Of_Lang.(module_ empty m) in + ty let lookup_root_module name env = let result = diff --git a/src/xref2/link.ml b/src/xref2/link.ml index 45d4906139..a602d7899c 100644 --- a/src/xref2/link.ml +++ b/src/xref2/link.ml @@ -118,7 +118,7 @@ and content env id = let open Compilation_unit in function | Module m -> Module (signature env (id :> Id.Signature.t) m) - | Pack _ -> failwith "Unhandled content" + | Pack p -> Pack p and value_ env parent t = let open Value in