Resolve fully-qualified references in modules synopsis

This removes the previous warning when a reference was encountered and
instead attaches some informations to eventual errors reported while
resolving contained references.

Author: Julow

src/xref2/env.ml

@@ -744,6 +744,9 @@ let initial_env :
           | Not_found -> (import :: imports, env)))
     t.imports ([], initial_env)
 
+let inherit_resolver env =
+  match env.resolver with Some r -> set_resolver empty r | None -> empty
+
 let modules_of env =
   let f acc = function `Module (id, m) -> (id, m) :: acc | _ -> acc in
   StringMap.fold (fun _ e acc -> List.fold_left f acc e) env.elts []

src/xref2/env.mli

@@ -176,6 +176,9 @@ val initial_env :
   resolver ->
   Odoc_model.Lang.Compilation_unit.Import.t list * t
 
+val inherit_resolver : t -> t
+(** Create an empty environment reusing the same resolver. *)
+
 val modules_of :
   t ->
   (Odoc_model.Paths.Identifier.Path.Module.t

src/xref2/link.ml

@@ -30,19 +30,6 @@ let synopsis_of_module env (m : Component.Module.t) =
       | Ok sg -> synopsis_from_comment (Component.extract_signature_doc sg)
       | Error _ -> None)
 
-let warn_if_contains_references ~location p =
-  let is_ref = function
-    | { Location_.value = `Reference _; _ } -> true
-    | _ -> false
-  in
-  match p with
-  | Some p when List.exists is_ref p ->
-      Lookup_failures.with_location location (fun () ->
-          Lookup_failures.report ~kind:`Warning
-            "The synopsis from this module contains references that won't be \
-             resolved when included in this list.")
-  | _ -> ()
-
 exception Loop
 
 let rec is_forward : Paths.Path.Module.t -> bool = function
@@ -164,11 +151,20 @@ let rec comment_inline_element :
           orig)
   | y -> y
 
+and paragraph env elts =
+  List.map (with_location (comment_inline_element env)) elts
+
+and resolve_external_synopsis env ~location synopsis =
+  let env = Env.inherit_resolver env in
+  Lookup_failures.with_context
+    ~suggestion:
+      "Only fully-qualified references can be resolved in a synopsis."
+    location "resolving a module's synopsis" (fun () -> paragraph env synopsis)
+
 and comment_nestable_block_element env parent
     (x : Comment.nestable_block_element) =
   match x with
-  | `Paragraph elts ->
-      `Paragraph (List.map (with_location (comment_inline_element env)) elts)
+  | `Paragraph elts -> `Paragraph (paragraph env elts)
   | (`Code_block _ | `Verbatim _) as x -> x
   | `List (x, ys) ->
       `List
@@ -185,8 +181,11 @@ and comment_nestable_block_element env parent
             match Ref_tools.resolve_module_reference env ref with
             | Some (r, _, m) ->
                 let module_reference = Location_.at location (`Resolved r)
-                and module_synopsis = synopsis_of_module env m in
-                warn_if_contains_references ~location module_synopsis;
+                and module_synopsis =
+                  Opt.map
+                    (resolve_external_synopsis env ~location)
+                    (synopsis_of_module env m)
+                in
                 { Comment.module_reference; module_synopsis }
             | None -> r)
           refs

src/xref2/lookup_failures.ml

@@ -2,22 +2,32 @@ let strict_mode = ref false
 
 type kind = [ `Root | `Internal | `Warning ]
 
-type loc = Odoc_model.Location_.span option
+type loc = Odoc_model.Location_.span
 
-type 'a with_failures = 'a * (kind * string * loc) list
+type context = loc * string * string option
+(** Location * message * suggestion *)
+
+type 'a with_failures = 'a * (kind * string * loc option * context option) list
 
 let failure_acc = ref []
 
 let loc_acc = ref None
 
-let add ~kind f = failure_acc := (kind, f, !loc_acc) :: !failure_acc
+let context_acc = ref None
 
-let catch_failures f =
-  let prev = !failure_acc in
-  failure_acc := [];
+let add ~kind f =
+  failure_acc := (kind, f, !loc_acc, !context_acc) :: !failure_acc
+
+let with_var var x f =
+  let prev_x = !var in
+  var := x;
   let r = f () in
-  let failures = !failure_acc in
-  failure_acc := prev;
+  let last_x = !var in
+  var := prev_x;
+  (r, last_x)
+
+let catch_failures f =
+  let r, failures = with_var failure_acc [] f in
   (r, List.rev failures)
 
 let kasprintf k fmt =
@@ -30,12 +40,10 @@ let report ?(kind = `Internal) fmt = kasprintf (add ~kind) fmt
 let report_important ?(kind = `Internal) exn fmt =
   if !strict_mode then raise exn else kasprintf (add ~kind) fmt
 
-let with_location loc f =
-  let prev_loc = !loc_acc in
-  loc_acc := Some loc;
-  let r = f () in
-  loc_acc := prev_loc;
-  r
+let with_location loc f = fst (with_var loc_acc (Some loc) f)
+
+let with_context ?suggestion loc msg f =
+  fst (with_var context_acc (Some (loc, msg, suggestion)) f)
 
 let handle_failures ~warn_error ~filename (r, failures) =
   let open Odoc_model in
@@ -44,10 +52,19 @@ let handle_failures ~warn_error ~filename (r, failures) =
     | Some loc -> Error.make "%s" msg loc
     | None -> Error.filename_only "%s" msg filename
   in
-  let handle_failure ~warnings = function
-    | `Internal, msg, loc -> Error.warning warnings (error ~loc msg)
-    | `Warning, msg, loc -> Error.warning warnings (error ~loc msg)
-    | `Root, msg, loc -> prerr_endline (Error.to_string (error ~loc msg))
+  let handle_failure ~warnings (kind, msg, loc, context) =
+    let e = error ~loc msg in
+    let e =
+      match context with
+      | None -> e
+      | Some (cloc, cmsg, suggestion) ->
+          Error.make ?suggestion "The following error occurred while %s:@\n%s"
+            cmsg (Error.to_string e) cloc
+    in
+    match kind with
+    | `Internal -> Error.warning warnings e
+    | `Warning -> Error.warning warnings e
+    | `Root -> prerr_endline (Error.to_string e)
   in
   Error.accumulate_warnings (fun warnings ->
       List.iter (handle_failure ~warnings) failures;

src/xref2/lookup_failures.mli

@@ -23,6 +23,14 @@ val with_location : Odoc_model.Location_.span -> (unit -> 'a) -> 'a
 (** Failures reported indirectly by this function will have a location
     attached. *)
 
+val with_context :
+  ?suggestion:string ->
+  Odoc_model.Location_.span ->
+  string ->
+  (unit -> 'a) ->
+  'a
+(** Add context to every failures reported while executing [f]. *)
+
 val handle_failures :
   warn_error:bool ->
   filename:string ->

test/xref2/module_list.t/main.mli

@@ -59,9 +59,8 @@ module Inline_include : sig
 end
 
 module Resolve_synopsis : sig
-  (** {!t}
-
-      This reference should be resolved when included the list. *)
+  (** This should be resolved when included: {!Main.Resolve_synopsis.t}. These
+      shouldn't: {!t} {!Resolve_synopsis.t} *)
 
   type t
 end

test/xref2/module_list.t/run.t

@@ -2,11 +2,30 @@
 
   $ compile external.mli starts_with_open.mli main.mli
   File "external.mli", line 20, characters 4-36:
-  The synopsis from this module contains references that won't be resolved when included in this list.
+  The following error occurred while resolving a module's synopsis:
+  File "main.mli", line 63, characters 17-21:
+  Failed to resolve reference.
+  Suggestion: Only fully-qualified references can be resolved in a synopsis.
+  File "external.mli", line 20, characters 4-36:
+  The following error occurred while resolving a module's synopsis:
+  File "main.mli", line 63, characters 22-43:
+  Failed to resolve reference.
+  Suggestion: Only fully-qualified references can be resolved in a synopsis.
+  File "main.mli", line 1, character 4 to line 3, character 47:
+  The following error occurred while resolving a module's synopsis:
+  File "main.mli", line 63, characters 17-21:
+  Failed to resolve reference.
+  Suggestion: Only fully-qualified references can be resolved in a synopsis.
   File "main.mli", line 1, character 4 to line 3, character 47:
-  The synopsis from this module contains references that won't be resolved when included in this list.
+  The following error occurred while resolving a module's synopsis:
+  File "main.mli", line 63, characters 22-43:
+  Failed to resolve reference.
+  Suggestion: Only fully-qualified references can be resolved in a synopsis.
   File "main.mli", line 1, character 4 to line 3, character 47:
-  The synopsis from this module contains references that won't be resolved when included in this list.
+  The following error occurred while resolving a module's synopsis:
+  File "external.mli", line 9, characters 6-10:
+  Failed to resolve reference.
+  Suggestion: Only fully-qualified references can be resolved in a synopsis.
 
 Everything should resolve:
 
@@ -42,7 +61,7 @@ Everything should resolve:
   {"`Resolved":{"`Identifier":{"`Root":[{"`RootPage":"test"},"Starts_with_open"]}}}
   {"Some":[{"`Word":"Synopsis"},"`Space",{"`Word":"of"},"`Space",{"`Code_span":"Starts_with_open"},{"`Word":"."}]}
   {"`Resolved":{"`Identifier":{"`Module":[{"`Root":[{"`RootPage":"test"},"Main"]},"Resolve_synopsis"]}}}
-  {"Some":[{"`Reference":[{"`Root":["t","`TUnknown"]},[]]}]}
+  {"Some":[{"`Word":"This"},"`Space",{"`Word":"should"},"`Space",{"`Word":"be"},"`Space",{"`Word":"resolved"},"`Space",{"`Word":"when"},"`Space",{"`Word":"included:"},"`Space",{"`Reference":[{"`Resolved":{"`Type":[{"`Module":[{"`Identifier":{"`Root":[{"`RootPage":"test"},"Main"]}},"Resolve_synopsis"]},"t"]}},[]]},{"`Word":"."},"`Space",{"`Word":"These"},"`Space",{"`Word":"shouldn't:"},"`Space",{"`Reference":[{"`Root":["t","`TUnknown"]},[]]},"`Space",{"`Reference":[{"`Dot":[{"`Root":["Resolve_synopsis","`TUnknown"]},"t"]},[]]}]}
   {"`Resolved":{"`Module":[{"`Identifier":{"`Root":[{"`RootPage":"test"},"External"]}},"Resolve_synopsis"]}}
   {"Some":[{"`Reference":[{"`Root":["t","`TUnknown"]},[]]}]}
 
@@ -51,6 +70,6 @@ References in the synopses above should be resolved.
 
   $ odoc_print external.odocl | jq -c '.. | .["`Modules"]? | select(.) | .[] | .[]'
   {"`Resolved":{"`Module":[{"`Identifier":{"`Root":[{"`RootPage":"test"},"Main"]}},"Resolve_synopsis"]}}
-  {"Some":[{"`Reference":[{"`Root":["t","`TUnknown"]},[]]}]}
+  {"Some":[{"`Word":"This"},"`Space",{"`Word":"should"},"`Space",{"`Word":"be"},"`Space",{"`Word":"resolved"},"`Space",{"`Word":"when"},"`Space",{"`Word":"included:"},"`Space",{"`Reference":[{"`Resolved":{"`Type":[{"`Module":[{"`Identifier":{"`Root":[{"`RootPage":"test"},"Main"]}},"Resolve_synopsis"]},"t"]}},[]]},{"`Word":"."},"`Space",{"`Word":"These"},"`Space",{"`Word":"shouldn't:"},"`Space",{"`Reference":[{"`Root":["t","`TUnknown"]},[]]},"`Space",{"`Reference":[{"`Dot":[{"`Root":["Resolve_synopsis","`TUnknown"]},"t"]},[]]}]}
 
 'Type_of' and 'Alias' don't have a summary. `C1` and `C2` neither, we expect at least `C2` to have one.