Add raise tag reference

Co-authored-by: Jules Aguillon <[email protected]>

Author: sim642

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/model/comment.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/semantics.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_desc/comment_desc.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))

test/generators/html/Markup.html

@@ -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/Ocamlary.html

@@ -447,7 +447,7 @@ <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>

test/generators/html/Tag_link.html

@@ -30,9 +30,8 @@ <h1>Module <code><span>Tag_link</span></code></h1>
     </li>
    </ul>
    <ul class="at-tags">
-    <li class="raises"><span class="at-tag">raises</span> 
-     <span class="value">Foo</span> 
-     <p><a href="#val-foo"><code>foo</code></a></p>
+    <li class="raises"><span class="at-tag">raises</span> <code>Foo</code>
+      <p><a href="#val-foo"><code>foo</code></a></p>
     </li>
    </ul>
    <ul class="at-tags">

test/generators/latex/Markup.tex

@@ -119,7 +119,7 @@ \subsection{Tags\label{tags}}%
 }\end{description}%
 \begin{description}\kern-\topsep
 \makeatletter\advance\@topsepadd-\topsep\makeatother% topsep is hardcoded
-\item[{raises Failure}]{always
+\item[{raises \ocamlinlinecode{Failure}}]{always
 
 }\end{description}%
 \begin{description}\kern-\topsep

test/generators/latex/Ocamlary.tex

@@ -147,7 +147,7 @@ \subsubsection{Basic type and value stuff with advanced doc comments\label{basic
 \label{module-Ocamlary-val-fun_maybe}\ocamlcodefragment{\ocamltag{keyword}{val} fun\_\allowbreak{}maybe : ?yes:unit \ocamltag{arrow}{$\rightarrow$} unit \ocamltag{arrow}{$\rightarrow$} int}\\
 \label{module-Ocamlary-val-not_found}\ocamlcodefragment{\ocamltag{keyword}{val} not\_\allowbreak{}found : unit \ocamltag{arrow}{$\rightarrow$} unit}\begin{ocamlindent}\begin{description}\kern-\topsep
 \makeatletter\advance\@topsepadd-\topsep\makeatother% topsep is hardcoded
-\item[{raises Not\_\allowbreak{}found}]{That's all it does}\end{description}%
+\item[{raises \ocamlinlinecode{Not\_\allowbreak{}found}}]{That's all it does}\end{description}%
 \end{ocamlindent}%
 \medbreak
 \label{module-Ocamlary-val-ocaml_org}\ocamlcodefragment{\ocamltag{keyword}{val} ocaml\_\allowbreak{}org : string}\begin{ocamlindent}\begin{description}\kern-\topsep

test/generators/latex/Tag_link.tex

@@ -12,7 +12,7 @@ \section{Module \ocamlinlinecode{Tag\_\allowbreak{}link}}\label{module-Tag_link}
 }\end{description}%
 \begin{description}\kern-\topsep
 \makeatletter\advance\@topsepadd-\topsep\makeatother% topsep is hardcoded
-\item[{raises Foo}]{\hyperref[module-Tag_link-val-foo]{\ocamlinlinecode{\ocamlinlinecode{foo}}[p\pageref*{module-Tag_link-val-foo}]}
+\item[{raises \ocamlinlinecode{Foo}}]{\hyperref[module-Tag_link-val-foo]{\ocamlinlinecode{\ocamlinlinecode{foo}}[p\pageref*{module-Tag_link-val-foo}]}
 
 }\end{description}%
 \begin{description}\kern-\topsep