From 269bfd6bfb49b1077e71cbc7f9b92178d82ff53c Mon Sep 17 00:00:00 2001 From: Jon Ludlam Date: Wed, 21 Aug 2024 11:07:13 +0100 Subject: [PATCH 1/5] Add the ability to remap identifiers during HTML generation This is to allow the publishing of 'partial docsets' - the idea being that the driver proceeds as usual up until HTML generation, and at that point only generates HTML pages for the packages you wish to publish on your site, and remap links to other packages to ocaml.org or other site. --- src/html/config.ml | 6 +- src/html/config.mli | 3 + src/html/generator.ml | 2 +- src/html/html_fragment_json.ml | 4 +- src/html/html_page.ml | 4 +- src/html/link.ml | 125 +++++++++++++++----------- src/html/link.mli | 4 +- src/odoc/bin/main.ml | 18 +++- src/odoc/html_fragment.ml | 2 +- src/search/html.ml | 5 +- test/integration/remap.t/otherlib.mli | 2 + test/integration/remap.t/run.t | 25 ++++++ test/integration/remap.t/test.mli | 2 + 13 files changed, 137 insertions(+), 65 deletions(-) create mode 100644 test/integration/remap.t/otherlib.mli create mode 100644 test/integration/remap.t/run.t create mode 100644 test/integration/remap.t/test.mli diff --git a/src/html/config.ml b/src/html/config.ml index d7b8a32e23..587f84298a 100644 --- a/src/html/config.ml +++ b/src/html/config.ml @@ -4,6 +4,7 @@ type t = { theme_uri : Types.uri option; support_uri : Types.uri option; search_uris : Types.file_uri list; + remap : (string * string) list; semantic_uris : bool; search_result : bool; (* Used to not render links, for summary in search results *) @@ -14,7 +15,7 @@ type t = { } let v ?(search_result = false) ?theme_uri ?support_uri ?(search_uris = []) - ~semantic_uris ~indent ~flat ~open_details ~as_json () = + ~semantic_uris ~indent ~flat ~open_details ~as_json ~remap () = { semantic_uris; indent; @@ -25,6 +26,7 @@ let v ?(search_result = false) ?theme_uri ?support_uri ?(search_uris = []) search_uris; as_json; search_result; + remap; } let theme_uri config : Types.uri = @@ -46,3 +48,5 @@ let open_details config = config.open_details let as_json config = config.as_json let search_result config = config.search_result + +let remap config = config.remap diff --git a/src/html/config.mli b/src/html/config.mli index 8b6fee486b..493833410f 100644 --- a/src/html/config.mli +++ b/src/html/config.mli @@ -12,6 +12,7 @@ val v : flat:bool -> open_details:bool -> as_json:bool -> + remap:(string * string) list -> unit -> t (** [search_result] indicates whether this is a summary for a search result. In @@ -34,3 +35,5 @@ val open_details : t -> bool val as_json : t -> bool val search_result : t -> bool + +val remap : t -> (string * string) list diff --git a/src/html/generator.ml b/src/html/generator.ml index 58c5e34b27..1c7c8e4461 100644 --- a/src/html/generator.ml +++ b/src/html/generator.ml @@ -542,7 +542,7 @@ let render ~config ~sidebar = function | Source_page src -> [ Page.source_page ~config src ] let filepath ~config url = - Link.Path.as_filename ~is_flat:(Config.flat config) url + Link.Path.as_filename ~config url let doc ~config ~xref_base_uri b = let resolve = Link.Base xref_base_uri in diff --git a/src/html/html_fragment_json.ml b/src/html/html_fragment_json.ml index f2be013d7a..1deffdecf8 100644 --- a/src/html/html_fragment_json.ml +++ b/src/html/html_fragment_json.ml @@ -32,7 +32,7 @@ let json_of_toc (toc : Types.toc list) : Utils.Json.json = let make ~config ~preamble ~url ~breadcrumbs ~sidebar ~toc ~uses_katex ~source_anchor content children = - let filename = Link.Path.as_filename ~is_flat:(Config.flat config) url in + let filename = Link.Path.as_filename ~config url in let filename = Fpath.add_ext ".json" filename in let json_to_string json = Utils.Json.to_string json in let source_anchor = @@ -65,7 +65,7 @@ let make ~config ~preamble ~url ~breadcrumbs ~sidebar ~toc ~uses_katex { Odoc_document.Renderer.filename; content; children } let make_src ~config ~url ~breadcrumbs content = - let filename = Link.Path.as_filename ~is_flat:(Config.flat config) url in + let filename = Link.Path.as_filename ~config url in let filename = Fpath.add_ext ".json" filename in let htmlpp = Html.pp_elt ~indent:(Config.indent config) () in let json_to_string json = Utils.Json.to_string json in diff --git a/src/html/html_page.ml b/src/html/html_page.ml index 8cc9358298..3430c76348 100644 --- a/src/html/html_page.ml +++ b/src/html/html_page.ml @@ -244,7 +244,7 @@ let search_urls = %s; let make ~config ~url ~header ~breadcrumbs ~sidebar ~toc ~uses_katex content children = - let filename = Link.Path.as_filename ~is_flat:(Config.flat config) url in + let filename = Link.Path.as_filename ~config url in let content = page_creator ~config ~url ~uses_katex ~global_toc:sidebar header breadcrumbs toc content @@ -285,7 +285,7 @@ let src_page_creator ~breadcrumbs ~config ~url ~header name content = content let make_src ~config ~url ~breadcrumbs ~header title content = - let filename = Link.Path.as_filename ~is_flat:(Config.flat config) url in + let filename = Link.Path.as_filename ~config url in let content = src_page_creator ~breadcrumbs ~config ~url ~header title content in diff --git a/src/html/link.ml b/src/html/link.ml index 871bcc12df..083d282bc0 100644 --- a/src/html/link.ml +++ b/src/html/link.ml @@ -1,5 +1,7 @@ module Url = Odoc_document.Url +type link = Relative of string list * string | Absolute of string + (* Translation from Url.Path *) module Path = struct let for_printing url = List.map snd @@ Url.Path.to_list url @@ -11,10 +13,23 @@ module Path = struct let is_leaf_page url = url.Url.Path.kind = `LeafPage - let get_dir_and_file is_flat url = + let remap config f = + let l = String.concat "/" f in + match + List.find_opt + (fun (prefix, _replacement) -> Astring.String.is_prefix ~affix:prefix l) + (Config.remap config) + with + | None -> None + | Some (prefix, replacement) -> + let len = String.length prefix in + let l = String.sub l len (String.length l - len) in + Some (replacement ^ l) + + let get_dir_and_file ~config url = let l = Url.Path.to_list url in let is_dir = - if is_flat then function `Page -> `Always | _ -> `Never + if Config.flat config then function `Page -> `Always | _ -> `Never else function `LeafPage | `File | `SourcePage -> `Never | _ -> `Always in let dir, file = Url.Path.split ~is_dir l in @@ -26,19 +41,20 @@ module Path = struct | [ (`File, name) ] -> name | [ (`SourcePage, name) ] -> name ^ ".html" | xs -> - assert is_flat; + assert (Config.flat config); String.concat "-" (List.map segment_to_string xs) ^ ".html" in (dir, file) - let for_linking ~is_flat url = - let dir, file = get_dir_and_file is_flat url in - dir @ [ file ] + let for_linking ~config url = + let dir, file = get_dir_and_file ~config url in + match remap config dir with + | None -> Relative (dir, file) + | Some x -> Absolute (x ^ "/" ^ file) - let as_filename ~is_flat (url : Url.Path.t) = - let url_segs = for_linking ~is_flat url in - let filename = Fpath.(v @@ String.concat Fpath.dir_sep @@ url_segs) in - filename + let as_filename ~config (url : Url.Path.t) = + let dir, file = get_dir_and_file ~config url in + Fpath.(v @@ String.concat Fpath.dir_sep (dir @ [ file ])) end type resolve = Current of Url.Path.t | Base of string @@ -50,46 +66,55 @@ let rec drop_shared_prefix l1 l2 = let href ~config ~resolve t = let { Url.Anchor.page; anchor; _ } = t in + let add_anchor y = match anchor with "" -> y | anchor -> y ^ "#" ^ anchor in + let target_loc = Path.for_linking ~config page in - let target_loc = Path.for_linking ~is_flat:(Config.flat config) page in - - (* If xref_base_uri is defined, do not perform relative URI resolution. *) - match resolve with - | Base xref_base_uri -> ( - let page = xref_base_uri ^ String.concat "/" target_loc in - match anchor with "" -> page | anchor -> page ^ "#" ^ anchor) - | Current path -> ( - let current_loc = Path.for_linking ~is_flat:(Config.flat config) path in + match target_loc with + | Absolute y -> add_anchor y + | Relative (dir, file) -> ( + let target_loc = dir @ [ file ] in + (* If xref_base_uri is defined, do not perform relative URI resolution. *) + match resolve with + | Base xref_base_uri -> + let page = xref_base_uri ^ String.concat "/" target_loc in + add_anchor page + | Current path -> ( + let current_loc = + let dir, file = Path.get_dir_and_file ~config path in + dir @ [ file ] + in - let current_from_common_ancestor, target_from_common_ancestor = - drop_shared_prefix current_loc target_loc - in + let current_from_common_ancestor, target_from_common_ancestor = + drop_shared_prefix current_loc target_loc + in - let relative_target = - match current_from_common_ancestor with - | [] -> - (* We're already on the right page *) - (* If we're already on the right page, the target from our common - ancestor can't be anything other than the empty list *) - assert (target_from_common_ancestor = []); - [] - | [ _ ] -> - (* We're already in the right dir *) - target_from_common_ancestor - | l -> - (* We need to go up some dirs *) - List.map (fun _ -> "..") (List.tl l) @ target_from_common_ancestor - in - let remove_index_html l = - match List.rev l with - | "index.html" :: rest -> List.rev ("" :: rest) - | _ -> l - in - let relative_target = - if Config.semantic_uris config then remove_index_html relative_target - else relative_target - in - match (relative_target, anchor) with - | [], "" -> "#" - | page, "" -> String.concat "/" page - | page, anchor -> String.concat "/" page ^ "#" ^ anchor) + let relative_target = + match current_from_common_ancestor with + | [] -> + (* We're already on the right page *) + (* If we're already on the right page, the target from our common + ancestor can't be anything other than the empty list *) + assert (target_from_common_ancestor = []); + [] + | [ _ ] -> + (* We're already in the right dir *) + target_from_common_ancestor + | l -> + (* We need to go up some dirs *) + List.map (fun _ -> "..") (List.tl l) + @ target_from_common_ancestor + in + let remove_index_html l = + match List.rev l with + | "index.html" :: rest -> List.rev ("" :: rest) + | _ -> l + in + let relative_target = + if Config.semantic_uris config then + remove_index_html relative_target + else relative_target + in + match (relative_target, anchor) with + | [], "" -> "#" + | page, "" -> String.concat "/" page + | page, anchor -> String.concat "/" page ^ "#" ^ anchor)) diff --git a/src/html/link.mli b/src/html/link.mli index 72f929c379..3bff6dae3d 100644 --- a/src/html/link.mli +++ b/src/html/link.mli @@ -11,7 +11,5 @@ module Path : sig val for_printing : Url.Path.t -> string list - val for_linking : is_flat:bool -> Url.Path.t -> string list - - val as_filename : is_flat:bool -> Url.Path.t -> Fpath.t + val as_filename : config:Config.t -> Url.Path.t -> Fpath.t end diff --git a/src/odoc/bin/main.ml b/src/odoc/bin/main.ml index 8829f2efdd..d87c8aa480 100644 --- a/src/odoc/bin/main.ml +++ b/src/odoc/bin/main.ml @@ -1176,19 +1176,31 @@ module Odoc_html_args = struct in Arg.(value & flag & info ~doc [ "as-json" ]) + let remap = + let convert_remap = + let parse inp = + match Astring.String.cut ~sep:":" inp with + | Some (orig, mapped) -> Ok (orig, mapped) + | _ -> Error (`Msg "Map must be of the form ':https://...'") + and print fmt (orig, mapped) = Format.fprintf fmt "%s:%s" orig mapped in + Arg.conv (parse, print) + in + let doc = "Remap an identifier to an external URL." in + Arg.(value & opt_all convert_remap [] & info [ "R" ] ~doc) + let extra_args = let config semantic_uris closed_details indent theme_uri support_uri - search_uris flat as_json = + search_uris flat as_json remap = 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 () + ~indent ~flat ~open_details ~as_json ~remap () in { Html_page.html_config } in Term.( const config $ semantic_uris $ closed_details $ indent $ theme_uri - $ support_uri $ search_uri $ flat $ as_json) + $ support_uri $ search_uri $ flat $ as_json $ remap) end module Odoc_html = Make_renderer (Odoc_html_args) diff --git a/src/odoc/html_fragment.ml b/src/odoc/html_fragment.ml index fe4fe9663d..415cf36807 100644 --- a/src/odoc/html_fragment.ml +++ b/src/odoc/html_fragment.ml @@ -37,7 +37,7 @@ let from_mld ~xref_base_uri ~resolver ~output ~warnings_options input = let page = Odoc_document.Comment.to_ir resolved.content in let config = Odoc_html.Config.v ~semantic_uris:false ~indent:false ~flat:false - ~open_details:false ~as_json:false () + ~open_details:false ~as_json:false ~remap:[] () in let html = Odoc_html.Generator.doc ~config ~xref_base_uri page in let oc = open_out (Fs.File.to_string output) in diff --git a/src/search/html.ml b/src/search/html.ml index 747d45e88e..2f1db78e03 100644 --- a/src/search/html.ml +++ b/src/search/html.ml @@ -22,7 +22,8 @@ let url { Entry.id; kind; doc = _ } = | Ok url -> let config = Odoc_html.Config.v ~search_result:true ~semantic_uris:false - ~indent:false ~flat:false ~open_details:false ~as_json:false () + ~indent:false ~flat:false ~open_details:false ~as_json:false ~remap:[] + () in let url = Odoc_html.Link.href ~config ~resolve:(Base "") url in Result.Ok url @@ -201,7 +202,7 @@ let names_of_id id = let of_doc doc = let config = Odoc_html.Config.v ~search_result:true ~semantic_uris:false ~indent:false - ~flat:false ~open_details:false ~as_json:false () + ~flat:false ~open_details:false ~as_json:false ~remap:[] () in Tyxml.Html.div ~a:[] @@ Odoc_html.Generator.doc ~config ~xref_base_uri:"" diff --git a/test/integration/remap.t/otherlib.mli b/test/integration/remap.t/otherlib.mli new file mode 100644 index 0000000000..0fe50342ec --- /dev/null +++ b/test/integration/remap.t/otherlib.mli @@ -0,0 +1,2 @@ +type t = Foo | Bar + diff --git a/test/integration/remap.t/run.t b/test/integration/remap.t/run.t new file mode 100644 index 0000000000..c2c274a2b5 --- /dev/null +++ b/test/integration/remap.t/run.t @@ -0,0 +1,25 @@ + $ ocamlc -c -bin-annot otherlib.mli + $ ocamlc -c -bin-annot test.mli + $ odoc compile --parent-id prefix/otherpkg/doc --output-dir _odoc otherlib.cmti + $ odoc compile --parent-id prefix/mypkg/doc --output-dir _odoc test.cmti + $ odoc link _odoc/prefix/otherpkg/doc/otherlib.odoc + $ odoc link -I _odoc/prefix/otherpkg/doc _odoc/prefix/mypkg/doc/test.odoc + +We should be able to remap the links to one of the packages: + + $ odoc html-generate -o _html --indent _odoc/prefix/mypkg/doc/test.odocl + $ odoc html-generate -o _html2 --indent _odoc/prefix/mypkg/doc/test.odocl -R prefix/otherpkg/:https://mysite.org/p/otherpkg/1.2.3/ + + $ diff _html/prefix/mypkg/doc/Test/index.html _html2/prefix/mypkg/doc/Test/index.html + 25c25,27 + < Otherlib.t + --- + > href="https://mysite.org/p/otherpkg/1.2.3/doc/Otherlib/index.html#type-t" + > >Otherlib.t + [1] + +This shouldn't stop us from outputting the remapped package though, and the following should complete without error + + $ odoc html-generate -o _html3 _odoc/prefix/otherpkg/doc/otherlib.odocl -R prefix/otherpkg/:https://mysite.org/p/otherpkg/1.2.3/ + diff --git a/test/integration/remap.t/test.mli b/test/integration/remap.t/test.mli new file mode 100644 index 0000000000..202ccb07e5 --- /dev/null +++ b/test/integration/remap.t/test.mli @@ -0,0 +1,2 @@ +type t = Otherlib.t + From 5f703c847cb50212e341f1f02f80abb309c580ca Mon Sep 17 00:00:00 2001 From: Jon Ludlam Date: Wed, 21 Aug 2024 11:20:55 +0100 Subject: [PATCH 2/5] Update CHANGES --- CHANGES.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGES.md b/CHANGES.md index d825060476..63213caf87 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -28,6 +28,7 @@ - Allow referencing assets (@panglesd, #1171) - Added a `--asset-path` arg to `html-generate` (@panglesd, #1185) - Add a frontmatter syntax for mld pages (@panglesd, #1187) +- Add a 'remap' option to HTML generation for partial docsets (@jonludlam, #1189) ### Changed From 452524f5d627454795c09ca7409129530579c4e9 Mon Sep 17 00:00:00 2001 From: Jon Ludlam Date: Wed, 21 Aug 2024 14:01:20 +0100 Subject: [PATCH 3/5] Compat --- src/html/link.ml | 21 +++++++++++---------- src/odoc/bin/main.ml | 2 +- 2 files changed, 12 insertions(+), 11 deletions(-) diff --git a/src/html/link.ml b/src/html/link.ml index 083d282bc0..616bb9b5bd 100644 --- a/src/html/link.ml +++ b/src/html/link.ml @@ -15,16 +15,17 @@ module Path = struct let remap config f = let l = String.concat "/" f in - match - List.find_opt - (fun (prefix, _replacement) -> Astring.String.is_prefix ~affix:prefix l) - (Config.remap config) - with - | None -> None - | Some (prefix, replacement) -> - let len = String.length prefix in - let l = String.sub l len (String.length l - len) in - Some (replacement ^ l) + try + let prefix, replacement = + List.find + (fun (prefix, _replacement) -> + Astring.String.is_prefix ~affix:prefix l) + (Config.remap config) + in + let len = String.length prefix in + let l = String.sub l len (String.length l - len) in + Some (replacement ^ l) + with Not_found -> None let get_dir_and_file ~config url = let l = Url.Path.to_list url in diff --git a/src/odoc/bin/main.ml b/src/odoc/bin/main.ml index d87c8aa480..e9936c3271 100644 --- a/src/odoc/bin/main.ml +++ b/src/odoc/bin/main.ml @@ -1180,7 +1180,7 @@ module Odoc_html_args = struct let convert_remap = let parse inp = match Astring.String.cut ~sep:":" inp with - | Some (orig, mapped) -> Ok (orig, mapped) + | Some (orig, mapped) -> Result.Ok (orig, mapped) | _ -> Error (`Msg "Map must be of the form ':https://...'") and print fmt (orig, mapped) = Format.fprintf fmt "%s:%s" orig mapped in Arg.conv (parse, print) From 3380fc871b1a12c4b211601d6cfde2d36f3610ad Mon Sep 17 00:00:00 2001 From: Jon Ludlam Date: Tue, 27 Aug 2024 12:09:24 +0100 Subject: [PATCH 4/5] Improvements following review Apply @panglesd's suggestion and fix the test as 'diff' gives a different output on Alpine. --- src/html/link.ml | 3 +-- test/integration/remap.t/run.t | 11 +++-------- 2 files changed, 4 insertions(+), 10 deletions(-) diff --git a/src/html/link.ml b/src/html/link.ml index 616bb9b5bd..74c68d924c 100644 --- a/src/html/link.ml +++ b/src/html/link.ml @@ -117,5 +117,4 @@ let href ~config ~resolve t = in match (relative_target, anchor) with | [], "" -> "#" - | page, "" -> String.concat "/" page - | page, anchor -> String.concat "/" page ^ "#" ^ anchor)) + | page, _ -> add_anchor @@ String.concat "/" page)) diff --git a/test/integration/remap.t/run.t b/test/integration/remap.t/run.t index c2c274a2b5..3dd174998c 100644 --- a/test/integration/remap.t/run.t +++ b/test/integration/remap.t/run.t @@ -10,14 +10,9 @@ We should be able to remap the links to one of the packages: $ odoc html-generate -o _html --indent _odoc/prefix/mypkg/doc/test.odocl $ odoc html-generate -o _html2 --indent _odoc/prefix/mypkg/doc/test.odocl -R prefix/otherpkg/:https://mysite.org/p/otherpkg/1.2.3/ - $ diff _html/prefix/mypkg/doc/Test/index.html _html2/prefix/mypkg/doc/Test/index.html - 25c25,27 - < Otherlib.t - --- - > href="https://mysite.org/p/otherpkg/1.2.3/doc/Otherlib/index.html#type-t" - > >Otherlib.t - [1] + $ grep Otherlib/index.html _html/prefix/mypkg/doc/Test/index.html _html2/prefix/mypkg/doc/Test/index.html + _html/prefix/mypkg/doc/Test/index.html: Otherlib.t + _html2/prefix/mypkg/doc/Test/index.html: href="https://mysite.org/p/otherpkg/1.2.3/doc/Otherlib/index.html#type-t" This shouldn't stop us from outputting the remapped package though, and the following should complete without error From 285dfe3ece596aa923a3ab9e61d9d04641dd2238 Mon Sep 17 00:00:00 2001 From: Jon Ludlam Date: Tue, 27 Aug 2024 13:01:30 +0100 Subject: [PATCH 5/5] Formatting --- src/html/generator.ml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/html/generator.ml b/src/html/generator.ml index 1c7c8e4461..a0e332bea9 100644 --- a/src/html/generator.ml +++ b/src/html/generator.ml @@ -541,8 +541,7 @@ let render ~config ~sidebar = function | Document.Page page -> [ Page.page ~config ~sidebar page ] | Source_page src -> [ Page.source_page ~config src ] -let filepath ~config url = - Link.Path.as_filename ~config url +let filepath ~config url = Link.Path.as_filename ~config url let doc ~config ~xref_base_uri b = let resolve = Link.Base xref_base_uri in