Merge pull request #888 from sim642/raise-ref

Treat raise tag value as reference

Author: Julow

src/document/comment.ml

@@ -274,14 +274,11 @@ let tag : Comment.tag -> Description.one =
   let sp = inline (Text " ") in
   let item ?value ~tag definition =
     let tag_name = inline ~attr:[ "at-tag" ] (Text tag) in
-    let tag_value =
-      match value with
-      | None -> []
-      | Some t -> [ sp; inline ~attr:[ "value" ] t ]
-    in
+    let tag_value = match value with None -> [] | Some t -> sp :: t in
     let key = tag_name :: tag_value in
     { Description.attr = [ tag ]; key; definition }
   in
+  let mk_value desc = [ inline ~attr:[ "value" ] desc ] in
   let text_def s = [ block (Block.Inline [ inline @@ Text s ]) ] in
   let content_to_inline ?(prefix = []) content =
     match content with
@@ -293,23 +290,23 @@ let tag : Comment.tag -> Description.one =
   | `Deprecated content ->
       item ~tag:"deprecated" (nestable_block_element_list content)
   | `Param (name, content) ->
-      let value = Inline.Text name in
+      let value = mk_value (Inline.Text name) in
       item ~tag:"parameter" ~value (nestable_block_element_list content)
-  | `Raise (name, content) ->
-      let value = Inline.Text name in
+  | `Raise (kind, content) ->
+      let value = inline_element (kind :> Comment.inline_element) in
       item ~tag:"raises" ~value (nestable_block_element_list content)
   | `Return content -> item ~tag:"returns" (nestable_block_element_list content)
   | `See (kind, target, content) ->
       let value =
         match kind with
-        | `Url -> Inline.Link (target, [ inline @@ Text target ])
-        | `File -> Inline.Source (source_of_code target)
-        | `Document -> Inline.Text target
+        | `Url -> mk_value (Inline.Link (target, [ inline @@ Text target ]))
+        | `File -> mk_value (Inline.Source (source_of_code target))
+        | `Document -> mk_value (Inline.Text target)
       in
       item ~tag:"see" ~value (nestable_block_element_list content)
   | `Since s -> item ~tag:"since" (text_def s)
   | `Before (version, content) ->
-      let value = Inline.Text version in
+      let value = mk_value (Inline.Text version) in
       item ~tag:"before" ~value (nestable_block_element_list content)
   | `Version s -> item ~tag:"version" (text_def s)
   | `Alert ("deprecated", content) ->

src/html_support_files/odoc.css

@@ -408,7 +408,7 @@ tt, code, pre {
   padding: 0 0.3ex;
 }
 
-p a > code {
+p a > code, li a > code {
   color: var(--link-color);
 }
 

src/html_support_files/odoc_html_support_files.ml

@@ -24,10 +24,12 @@ type non_link_inline_element =
    cross-referencer. *)
 type link_content = non_link_inline_element with_location list
 
+type reference_element = [ `Reference of Reference.t * link_content ]
+
 type inline_element =
   [ leaf_inline_element
   | `Styled of style * inline_element with_location list
-  | `Reference of Reference.t * link_content
+  | reference_element
   | `Link of string * link_content ]
 
 type paragraph = inline_element with_location list
@@ -53,7 +55,9 @@ type tag =
   [ `Author of string
   | `Deprecated of nestable_block_element with_location list
   | `Param of string * nestable_block_element with_location list
-  | `Raise of string * nestable_block_element with_location list
+  | `Raise of
+    [ `Code_span of string | reference_element ]
+    * nestable_block_element with_location list
   | `Return of nestable_block_element with_location list
   | `See of
     [ `Url | `File | `Document ]

src/model/comment.ml

@@ -271,8 +271,17 @@ let tag :
       ok (`Deprecated (nestable_block_elements status content))
   | `Param (name, content) ->
       ok (`Param (name, nestable_block_elements status content))
-  | `Raise (name, content) ->
-      ok (`Raise (name, nestable_block_elements status content))
+  | `Raise (name, content) -> (
+      match Error.raise_warnings (Reference.parse location name) with
+      (* TODO: location for just name *)
+      | Result.Ok target ->
+          ok
+            (`Raise
+              (`Reference (target, []), nestable_block_elements status content))
+      | Result.Error error ->
+          Error.raise_warning error;
+          let placeholder = `Code_span name in
+          ok (`Raise (placeholder, nestable_block_elements status content)))
   | `Return content -> ok (`Return (nestable_block_elements status content))
   | `See (kind, target, content) ->
       ok (`See (kind, target, nestable_block_elements status content))

src/model/semantics.ml

@@ -33,7 +33,10 @@ and general_tag =
   [ `Author of string
   | `Deprecated of general_docs
   | `Param of string * general_docs
-  | `Raise of string * general_docs
+  | `Raise of
+    [ `Code_span of string
+    | `Reference of Paths.Reference.t * general_link_content ]
+    * general_docs
   | `Return of general_docs
   | `See of [ `Url | `File | `Document ] * string * general_docs
   | `Since of string
@@ -124,7 +127,11 @@ and tag : general_tag t =
     | `Author x -> C ("`Author", x, string)
     | `Deprecated x -> C ("`Deprecated", x, docs)
     | `Param (x1, x2) -> C ("`Param", (x1, x2), Pair (string, docs))
-    | `Raise (x1, x2) -> C ("`Raise", (x1, x2), Pair (string, docs))
+    | `Raise (x1, x2) ->
+        C
+          ( "`Raise",
+            ((x1 :> general_inline_element), x2),
+            Pair (inline_element, docs) )
     | `Return x -> C ("`Return", x, docs)
     | `See (x1, x2, x3) ->
         C ("`See", (x1, x2, x3), Triple (url_kind, string, docs))

src/model_desc/comment_desc.ml

@@ -226,6 +226,9 @@ val fun_maybe : ?yes:unit -> unit -> int
 val not_found : unit -> unit
 (** @raise Not_found That's all it does *)
 
+val kaboom : unit -> unit
+(** @raise Kaboom That's all it does *)
+
 val ocaml_org : string
 (** @see <http://ocaml.org/> The OCaml Web site *)
 

src/ocamlary/ocamlary.mli

@@ -278,8 +278,18 @@ and comment_tag env parent ~loc:_ (x : Comment.tag) =
       `Deprecated (comment_nestable_block_element_list env parent content)
   | `Param (name, content) ->
       `Param (name, comment_nestable_block_element_list env parent content)
-  | `Raise (name, content) ->
-      `Raise (name, comment_nestable_block_element_list env parent content)
+  | `Raise ((`Reference (r, reference_content) as orig), content) -> (
+      match Ref_tools.resolve_reference env r |> Error.raise_warnings with
+      | Ok x ->
+          `Raise
+            ( `Reference (`Resolved x, reference_content),
+              comment_nestable_block_element_list env parent content )
+      | Error e ->
+          Errors.report ~what:(`Reference r) ~tools_error:(`Reference e)
+            `Resolve;
+          `Raise (orig, comment_nestable_block_element_list env parent content))
+  | `Raise ((`Code_span _ as orig), content) ->
+      `Raise (orig, comment_nestable_block_element_list env parent content)
   | `Return content ->
       `Return (comment_nestable_block_element_list env parent content)
   | `See (kind, target, content) ->

src/xref2/link.ml

@@ -240,7 +240,7 @@ <h2 id="math"><a href="#math" class="anchor"></a>Math</h2>
    </ul>
    <ul class="at-tags">
     <li class="raises"><span class="at-tag">raises</span> 
-     <span class="value">Failure</span> <p>always</p>
+     <code>Failure</code> <p>always</p>
     </li>
    </ul>
    <ul class="at-tags">

test/generators/html/Markup.html

@@ -447,7 +447,25 @@ <h4 id="basic-type-and-value-stuff-with-advanced-doc-comments">
     <div class="spec-doc">
      <ul class="at-tags">
       <li class="raises"><span class="at-tag">raises</span> 
-       <span class="value">Not_found</span> <p>That's all it does</p>
+       <code>Not_found</code> <p>That's all it does</p>
+      </li>
+     </ul>
+    </div>
+   </div>
+   <div class="odoc-spec">
+    <div class="spec value anchored" id="val-kaboom">
+     <a href="#val-kaboom" class="anchor"></a>
+     <code>
+      <span><span class="keyword">val</span> kaboom : 
+       <span>unit <span class="arrow">&#45;&gt;</span></span> unit
+      </span>
+     </code>
+    </div>
+    <div class="spec-doc">
+     <ul class="at-tags">
+      <li class="raises"><span class="at-tag">raises</span> 
+       <a href="#exception-Kaboom"><code>Kaboom</code></a> 
+       <p>That's all it does</p>
       </li>
      </ul>
     </div>