Skip to content

Commit

Permalink
Refactor change API of Url.from_identifier
Browse files Browse the repository at this point in the history
  • Loading branch information
@panglesd
panglesd committed Nov 12, 2024
1 parent 18910af commit 7f8c5d9
Show file tree
Hide file tree
Showing 11 changed files with 152 additions and 259 deletions.
16 changes: 5 additions & 11 deletions src/document/comment.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -107,7 +107,7 @@ module Reference = struct
let to_ir : ?text:Inline.t -> Reference.t -> Inline.t =
fun ?text ref ->
match ref with
| `Resolved r -> (
| `Resolved r ->
(* IDENTIFIER MUST BE RENAMED TO DEFINITION. *)
let id = Reference.Resolved.identifier r in
let rendered = render_resolved r in
Expand All @@ -119,16 +119,10 @@ module Reference = struct
(* Add a tooltip if the content is not the rendered reference. *)
match text with None -> None | Some _ -> Some rendered
in
match Url.from_identifier ~stop_before:false id with
| Ok url ->
let target = Target.Internal (Resolved url) in
let link = { Link.target; content; tooltip } in
[ inline @@ Inline.Link link ]
| Error (Not_linkable _) -> content
| Error exn ->
(* FIXME: better error message *)
Printf.eprintf "Id.href failed: %S\n%!" (Url.Error.to_string exn);
content)
let url = Url.from_identifier ~stop_before:false id in
let target = Target.Internal (Resolved url) in
let link = { Link.target; content; tooltip } in
[ inline @@ Inline.Link link ]
| _ -> (
let s = render_unresolved ref in
match text with
Expand Down
133 changes: 51 additions & 82 deletions src/document/generator.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -43,18 +43,15 @@ let unresolved content =
O.elt [ inline @@ Link link ]

let path_to_id path =
match Url.Anchor.from_identifier (path :> Paths.Identifier.t) with
| Error _ -> None
| Ok url -> Some url
let url = Url.Anchor.from_identifier (path :> Paths.Identifier.t) in
Some url

let source_anchor source_loc =
(* Remove when dropping support for OCaml < 4.08 *)
let to_option = function Result.Ok x -> Some x | Result.Error _ -> None in
match source_loc with
| Some id ->
Url.Anchor.from_identifier
(id : Paths.Identifier.SourceLocation.t :> Paths.Identifier.t)
|> to_option
Some
(Url.Anchor.from_identifier
(id : Paths.Identifier.SourceLocation.t :> Paths.Identifier.t))
| _ -> None

let attach_expansion ?(status = `Default) (eq, o, e) page text =
Expand Down Expand Up @@ -133,7 +130,7 @@ module Make (Syntax : SYNTAX) = struct
| `Resolved _ when Paths.Path.is_hidden path ->
let txt = Url.render_path path in
unresolved [ inline @@ Text txt ]
| `Resolved rp -> (
| `Resolved rp ->
(* If the path is pointing to an opaque module or module type
there won't be a page generated - so we stop before; at
the parent page, and link instead to the anchor representing
Expand All @@ -145,12 +142,8 @@ module Make (Syntax : SYNTAX) = struct
in
let id = Paths.Path.Resolved.identifier rp in
let txt = Url.render_path path in
match Url.from_identifier ~stop_before id with
| Ok href -> resolved href [ inline @@ Text txt ]
| Error (Url.Error.Not_linkable _) -> O.txt txt
| Error exn ->
Printf.eprintf "Id.href failed: %S\n%!" (Url.Error.to_string exn);
O.txt txt)
let href = Url.from_identifier ~stop_before id in
resolved href [ inline @@ Text txt ]

let dot prefix suffix = prefix ^ "." ^ suffix

Expand Down Expand Up @@ -194,13 +187,8 @@ module Make (Syntax : SYNTAX) = struct
let open Fragment in
let id = Resolved.identifier (fragment :> Resolved.t) in
let txt = render_resolved_fragment (fragment :> Resolved.t) in
match Url.from_identifier ~stop_before:false id with
| Ok href -> resolved href [ inline @@ Text txt ]
| Error (Not_linkable _) -> unresolved [ inline @@ Text txt ]
| Error exn ->
Printf.eprintf "[FRAG] Id.href failed: %S\n%!"
(Url.Error.to_string exn);
unresolved [ inline @@ Text txt ]
let href = Url.from_identifier ~stop_before:false id in
resolved href [ inline @@ Text txt ]

let from_fragment : Fragment.leaf -> text = function
| `Resolved r
Expand Down Expand Up @@ -276,10 +264,8 @@ module Make (Syntax : SYNTAX) = struct
in
let implementation =
match implementation with
| Some (Odoc_model.Lang.Source_info.Resolved id) -> (
match Url.Anchor.from_identifier (id :> Paths.Identifier.t) with
| Ok url -> Some url
| Error _ -> None)
| Some (Odoc_model.Lang.Source_info.Resolved id) ->
Some (Url.Anchor.from_identifier (id :> Paths.Identifier.t))
| _ -> None
in
Some (Source_page.Link { implementation; documentation })
Expand Down Expand Up @@ -519,26 +505,22 @@ module Make (Syntax : SYNTAX) = struct
end = struct
let record fields =
let field mutable_ id typ =
match Url.from_identifier ~stop_before:true id with
| Error e -> failwith (Url.Error.to_string e)
| Ok url ->
let name = Paths.Identifier.name id in
let attrs =
[ "def"; "record"; Url.Anchor.string_of_kind url.kind ]
in
let cell =
(* O.td ~a:[ O.a_class ["def"; kind ] ]
* [O.a ~a:[O.a_href ("#" ^ anchor); O.a_class ["anchor"]] []
* ; *)
O.code
((if mutable_ then O.keyword "mutable" ++ O.txt " " else O.noop)
++ O.txt name
++ O.txt Syntax.Type.annotation_separator
++ type_expr typ
++ O.txt Syntax.Type.Record.field_separator)
(* ] *)
in
(url, attrs, cell)
let url = Url.from_identifier ~stop_before:true id in
let name = Paths.Identifier.name id in
let attrs = [ "def"; "record"; Url.Anchor.string_of_kind url.kind ] in
let cell =
(* O.td ~a:[ O.a_class ["def"; kind ] ]
* [O.a ~a:[O.a_href ("#" ^ anchor); O.a_class ["anchor"]] []
* ; *)
O.code
((if mutable_ then O.keyword "mutable" ++ O.txt " " else O.noop)
++ O.txt name
++ O.txt Syntax.Type.annotation_separator
++ type_expr typ
++ O.txt Syntax.Type.Record.field_separator)
(* ] *)
in
(url, attrs, cell)
in
let rows =
fields
Expand Down Expand Up @@ -605,17 +587,13 @@ module Make (Syntax : SYNTAX) = struct

let variant cstrs : DocumentedSrc.t =
let constructor id args res =
match Url.from_identifier ~stop_before:true id with
| Error e -> failwith (Url.Error.to_string e)
| Ok url ->
let attrs =
[ "def"; "variant"; Url.Anchor.string_of_kind url.kind ]
in
let content =
let doc = constructor id args res in
O.documentedSrc (O.txt "| ") @ doc
in
(url, attrs, content)
let url = Url.from_identifier ~stop_before:true id in
let attrs = [ "def"; "variant"; Url.Anchor.string_of_kind url.kind ] in
let content =
let doc = constructor id args res in
O.documentedSrc (O.txt "| ") @ doc
in
(url, attrs, content)
in
match cstrs with
| [] -> O.documentedSrc (O.txt "|")
Expand All @@ -641,19 +619,13 @@ module Make (Syntax : SYNTAX) = struct

let extension_constructor (t : Odoc_model.Lang.Extension.Constructor.t) =
let id = (t.id :> Paths.Identifier.t) in
match Url.from_identifier ~stop_before:true id with
| Error e -> failwith (Url.Error.to_string e)
| Ok url ->
let anchor = Some url in
let attrs =
[ "def"; "variant"; Url.Anchor.string_of_kind url.kind ]
in
let code =
O.documentedSrc (O.txt "| ") @ constructor id t.args t.res
in
let doc = Comment.to_ir t.doc in
let markers = Syntax.Comment.markers in
DocumentedSrc.Nested { anchor; attrs; code; doc; markers }
let url = Url.from_identifier ~stop_before:true id in
let anchor = Some url in
let attrs = [ "def"; "variant"; Url.Anchor.string_of_kind url.kind ] in
let code = O.documentedSrc (O.txt "| ") @ constructor id t.args t.res in
let doc = Comment.to_ir t.doc in
let markers = Syntax.Comment.markers in
DocumentedSrc.Nested { anchor; attrs; code; doc; markers }

let extension (t : Odoc_model.Lang.Extension.t) =
let prefix =
Expand Down Expand Up @@ -1386,8 +1358,8 @@ module Make (Syntax : SYNTAX) = struct
let content = functor_parameter arg in
let attr = [ "parameter" ] in
let anchor =
Utils.option_of_result
@@ Url.Anchor.from_identifier (arg.id :> Paths.Identifier.t)
Some
(Url.Anchor.from_identifier (arg.id :> Paths.Identifier.t))
in
let doc = [] in
[
Expand Down Expand Up @@ -1614,11 +1586,10 @@ module Make (Syntax : SYNTAX) = struct
let name =
let open Odoc_model.Lang.FunctorParameter in
let name = Paths.Identifier.name arg.id in
match
let href =
Url.from_identifier ~stop_before (arg.id :> Paths.Identifier.t)
with
| Error _ -> O.txt name
| Ok href -> resolved href [ inline @@ Text name ]
in
resolved href [ inline @@ Text name ]
in
(if Syntax.Mod.functor_keyword then O.keyword "functor" else O.noop)
++ (O.box_hv @@ O.span
Expand Down Expand Up @@ -1655,12 +1626,11 @@ module Make (Syntax : SYNTAX) = struct
let name =
let open Odoc_model.Lang.FunctorParameter in
let name = Paths.Identifier.name arg.id in
match
let href =
Url.from_identifier ~stop_before
(arg.id :> Paths.Identifier.t)
with
| Error _ -> O.txt name
| Ok href -> resolved href [ inline @@ Text name ]
in
resolved href [ inline @@ Text name ]
in
O.box_hv
@@ O.txt "(" ++ name
Expand Down Expand Up @@ -1776,8 +1746,7 @@ module Make (Syntax : SYNTAX) = struct
in
let content = O.documentedSrc md_def in
let anchor =
Utils.option_of_result
@@ Url.Anchor.from_identifier (id :> Paths.Identifier.t)
Some (Url.Anchor.from_identifier (id :> Paths.Identifier.t))
in
let attr = [ "modules" ] in
let doc = [] in
Expand Down
12 changes: 3 additions & 9 deletions src/document/sidebar.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -22,10 +22,7 @@ end = struct
| None -> None
| Some (index_id, title) ->
let path =
match Url.from_identifier ~stop_before:false (index_id :> Id.t) with
| Ok r -> r
| Error _ -> assert false
(* This error case should never happen since [stop_before] is false, and even less since it's a page id *)
Url.from_identifier ~stop_before:false (index_id :> Id.t)
in
let content = Comment.link_content title in
Some (path, sidebar_toc_entry path content)
Expand Down Expand Up @@ -65,15 +62,12 @@ let of_lang (v : Odoc_index.sidebar) =
let item id =
let content = [ inline @@ Text (Odoc_model.Paths.Identifier.name id) ] in
let path = Url.from_identifier ~stop_before:false (id :> Id.t) in
match path with
| Ok path -> Some (path, sidebar_toc_entry path content)
| Error _ -> None
(* This error case should never happen since [stop_before] is false *)
(path, sidebar_toc_entry path content)
in
let units =
List.map
(fun { Odoc_index.units; name } ->
let units = List.filter_map item units in
let units = List.map item units in
{ name; units })
v.libs
in
Expand Down
Loading

0 comments on commit 7f8c5d9

Please sign in to comment.