Map reference to url

src/latex/generator.mli

@@ -1,3 +1,7 @@
+module Link : sig
+  val label : Odoc_document.Url.t -> string
+end
+
 val files_of_url : Odoc_document.Url.Path.t -> Fpath.t list
 
 val render :

src/model/error.ml

@@ -36,8 +36,10 @@ let _to_string =
   in
   fun ?prefix -> function
     | `With_full_location { location; message } ->
-        Format.asprintf "%a:@\n%a%s" Location_.pp location pp_prefix prefix
-          message
+        if String.compare location.file "" != 0 then
+          Format.asprintf "%a:@\n%a%s" Location_.pp location pp_prefix prefix
+            message
+        else Format.asprintf "%a%s" pp_prefix prefix message
     | `With_filename_only { file; message } ->
         Format.asprintf "File \"%s\":@\n%a%s" file pp_prefix prefix message
 

src/odoc/bin/main.ml

@@ -403,6 +403,55 @@ end = struct
   let targets = Targets.(cmd, info)
 end
 
+module Odoc_html_url : sig
+  val cmd : unit Term.t
+
+  val info : Term.info
+end = struct
+  let root_url =
+    let doc =
+      "A string to prepend to the generated relative url. A separating / is \
+       added if needed."
+    in
+    Arg.(value & opt (some string) None & info [ "r"; "root-url" ] ~doc)
+
+  let reference =
+    let doc = "The reference to be resolved and whose url to be generated." in
+    Arg.(required & pos 0 (some string) None & info ~doc ~docv:"REF" [])
+
+  let reference_to_url = Url.reference_to_url_html
+
+  let cmd =
+    Term.(
+      const handle_error
+      $ (const reference_to_url $ root_url $ odoc_file_directories $ reference))
+
+  let info =
+    Term.info ~doc:"Resolve a reference and output its corresponding url"
+      "html-url"
+end
+
+module Odoc_latex_url : sig
+  val cmd : unit Term.t
+
+  val info : Term.info
+end = struct
+  let reference =
+    let doc = "The reference to be resolved and whose url to be generated." in
+    Arg.(required & pos 0 (some string) None & info ~doc ~docv:"REF" [])
+
+  let reference_to_url = Url.reference_to_url_latex
+
+  let cmd =
+    Term.(
+      const handle_error
+      $ (const reference_to_url $ odoc_file_directories $ reference))
+
+  let info =
+    Term.info ~doc:"Resolve a reference and output its corresponding url"
+      "latex-url"
+end
+
 module Odoc_html = Make_renderer (struct
   type args = Html_page.args
 
@@ -736,6 +785,8 @@ let () =
       Targets.Support_files.(cmd, info);
       Odoc_link.(cmd, info);
       Odoc_error.(cmd, info);
+      Odoc_html_url.(cmd, info);
+      Odoc_latex_url.(cmd, info);
     ]
   in
   let default =

src/odoc/resolver.ml

@@ -203,23 +203,29 @@ let create ~important_digests ~directories ~open_modules =
   { important_digests; ap; open_modules }
 
 (** [important_digests] and [imports_map] only apply to modules. *)
-let build { important_digests; ap; open_modules } ~imports_map u =
-  add_unit_to_cache u;
+let build ?u { important_digests; ap; open_modules } ~imports_map =
+  (match u with Some u -> add_unit_to_cache u | None -> ());
   let lookup_unit = lookup_unit ~important_digests ~imports_map ap
   and lookup_page = lookup_page ap in
   { Odoc_xref2.Env.open_units = open_modules; lookup_unit; lookup_page }
 
 let build_env_for_unit t ~linking m =
   let imports_map = build_imports_map m in
-  let resolver = build t ~imports_map (Odoc_file.Unit_content m) in
+  let resolver = build ~u:(Odoc_file.Unit_content m) t ~imports_map in
   Odoc_xref2.Env.env_of_unit m ~linking resolver
 
 let build_env_for_page t p =
   let imports_map = StringMap.empty in
   let t = { t with important_digests = false } in
-  let resolver = build t ~imports_map (Odoc_file.Page_content p) in
+  let resolver = build ~u:(Odoc_file.Page_content p) t ~imports_map in
   Odoc_xref2.Env.env_of_page p resolver
 
+let build_env_for_reference t =
+  let imports_map = StringMap.empty in
+  let t = { t with important_digests = false } in
+  let resolver = build t ~imports_map in
+  Odoc_xref2.Env.env_for_reference resolver
+
 let lookup_page t target_name = lookup_page t.ap target_name
 
 let resolve_import t target_name =

src/odoc/resolver.mli

@@ -43,6 +43,9 @@ val build_env_for_unit :
 val build_env_for_page : t -> Odoc_model.Lang.Page.t -> Odoc_xref2.Env.t
 (** Initialize the environment for the given page. *)
 
+val build_env_for_reference : t -> Odoc_xref2.Env.t
+(** Initialize the environment for a reference. *)
+
 val resolve_import : t -> string -> Odoc_model.Root.t option
 (** Similar to {!Odoc_xref2.Env.lookup_root_module} but save work by loading
     only the root. Only used when resolving imports, which are needed for the

src/odoc/url.ml

@@ -0,0 +1,56 @@
+open Result
+
+let resolve url_to_string directories reference =
+  let resolver =
+    Resolver.create ~important_digests:false ~directories ~open_modules:[]
+  in
+  let reference =
+    let open Odoc_model in
+    let warnings_options = { Error.warn_error = true; print_warnings = true } in
+    Semantics.parse_reference reference
+    |> Error.handle_errors_and_warnings ~warnings_options
+  in
+  match reference with
+  | Error e -> Error e
+  | Ok reference -> (
+      let environment = Resolver.build_env_for_reference resolver in
+      let resolved_reference =
+        Odoc_xref2.Ref_tools.resolve_reference environment reference
+        |> Odoc_model.Error.raise_warnings
+      in
+      match resolved_reference with
+      | Error e ->
+          let error =
+            Format.asprintf "%a"
+              Odoc_xref2.Errors.Tools_error.pp_reference_lookup_error e
+          in
+          Error (`Msg error)
+      | Ok resolved_reference -> (
+          let identifier =
+            Odoc_model.Paths.Reference.Resolved.identifier resolved_reference
+          in
+          let url =
+            Odoc_document.Url.from_identifier ~stop_before:false identifier
+          in
+          match url with
+          | Error e -> Error (`Msg (Odoc_document.Url.Error.to_string e))
+          | Ok url ->
+              let href = url_to_string url in
+              print_endline href;
+              Ok ()))
+
+let reference_to_url_html root_url =
+  let url_to_string url =
+    let base =
+      match root_url with
+      | None | Some "" -> ""
+      | Some base ->
+          if base.[String.length base - 1] = '/' then base else base ^ "/"
+    in
+    Odoc_html.Link.(href ~resolve:(Base base) url)
+  in
+  resolve url_to_string
+
+let reference_to_url_latex =
+  let url_to_string url = Odoc_latex.Generator.Link.label url in
+  resolve url_to_string

src/xref2/env.ml

@@ -836,6 +836,9 @@ let env_of_page page resolver =
   let initial_env = open_page page empty in
   set_resolver initial_env resolver |> open_units resolver
 
+let env_for_reference resolver =
+  set_resolver empty resolver |> open_units resolver
+
 let env_for_testing ~linking = { empty with linking }
 
 let verify_lookups env lookups =

src/xref2/env.mli

@@ -164,6 +164,9 @@ val env_of_unit :
 val env_of_page : Odoc_model.Lang.Page.t -> resolver -> t
 (** Create a new env for a page. *)
 
+val env_for_reference : resolver -> t
+(** Create a new env for a reference. *)
+
 val env_for_testing : linking:bool -> t
 (** Create a new env for testing purposes *)
 

test/xref2/map_ref_to_url.t/foo.mli

@@ -0,0 +1 @@
+type t

test/xref2/map_ref_to_url.t/run.t

@@ -0,0 +1,27 @@
+  $ compile foo.mli
+
+Generating html url for a reference
+  $ odoc html-url -I . Foo.t
+  test/Foo/index.html#type-t
+
+The root-url argument prepends a string to the html url
+  $ odoc html-url -r /base -I . Foo.t
+  /base/test/Foo/index.html#type-t
+
+  $ odoc html-url --root-url=/base/ -I . Foo.t
+  /base/test/Foo/index.html#type-t
+
+Generate latex url
+  $ odoc latex-url -I . Foo.t
+  page-test-module-Foo-type-t
+
+When the reference cannot be resolved.
+  $ odoc html-url -I . Foo.u
+  ERROR: Couldn't find "u"
+  [1]
+
+When the reference cannot be parsed.
+  $ odoc html-url -I . ""
+  ERROR: Identifier in reference should not be empty.
+  [1]
+

test/xref2/refs/refs.md

@@ -856,14 +856,12 @@ val resolve_ref : string -> ref = <fun>
   (`Identifier (`Class (`Root (Some (`Page (None, None)), Root), c)), m)
 # resolve_ref "type-c.method-m" ;;
 Exception:
-Failure
- "File \"\", line 0, characters 0-6:\nExpected 'class-', 'class-type-', or an unqualified reference.".
+Failure "Expected 'class-', 'class-type-', or an unqualified reference.".
 # resolve_ref "type-t.m" ;;
 Exception: Failure "resolve_reference: Couldn't find \"m\"".
 # resolve_ref "type-t.method-m" ;;
 Exception:
-Failure
- "File \"\", line 0, characters 0-6:\nExpected 'class-', 'class-type-', or an unqualified reference.".
+Failure "Expected 'class-', 'class-type-', or an unqualified reference.".
 ```
 
 ## Failures