Skip to content

Commit e201e61

Browse files
panglesdjonludlam
panglesd
authored and
jonludlam
committed
Added lifting of alerts into odoc tags
Signed-off-by: Paul-Elliot <[email protected]>
1 parent ae62263 commit e201e61

File tree

6 files changed

+164
-20
lines changed

6 files changed

+164
-20
lines changed

‎src/document/comment.ml‎

Lines changed: 13 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -226,8 +226,8 @@ and nestable_block_element_list elements =
226226

227227
let tag : Comment.tag -> Description.one =
228228
fun t ->
229+
let sp = inline (Text " ") in
229230
let item ?value ~tag definition =
230-
let sp = inline (Text " ") in
231231
let tag_name = inline ~attr:[ "at-tag" ] (Text tag) in
232232
let tag_value =
233233
match value with
@@ -238,6 +238,11 @@ let tag : Comment.tag -> Description.one =
238238
{ Description.attr = [ tag ]; key; definition }
239239
in
240240
let text_def s = [ block (Block.Inline [ inline @@ Text s ]) ] in
241+
let content_to_inline ?(prefix = []) content =
242+
match content with
243+
| None -> []
244+
| Some content -> prefix @ [ inline @@ Text content ]
245+
in
241246
match t with
242247
| `Author s -> item ~tag:"author" (text_def s)
243248
| `Deprecated content ->
@@ -262,8 +267,13 @@ let tag : Comment.tag -> Description.one =
262267
let value = Inline.Text version in
263268
item ~tag:"before" ~value (nestable_block_element_list content)
264269
| `Version s -> item ~tag:"version" (text_def s)
265-
| `Alert (tag, Some content) -> item ~tag (text_def content)
266-
| `Alert (tag, None) -> item ~tag []
270+
| `Alert ("deprecated", content) ->
271+
let content = content_to_inline content in
272+
item ~tag:"deprecated" [ block (Block.Inline content) ]
273+
| `Alert (tag, content) ->
274+
let content = content_to_inline ~prefix:[ sp ] content in
275+
item ~tag:"alert"
276+
[ block (Block.Inline ([ inline @@ Text tag ] @ content)) ]
267277

268278
let attached_block_element : Comment.attached_block_element -> Block.t =
269279
function

‎src/loader/doc_attr.ml‎

Lines changed: 38 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -33,18 +33,34 @@ let empty_body = []
3333

3434
let empty : Odoc_model.Comment.docs = empty_body
3535

36-
let load_payload = function
37-
| Parsetree.PStr [{pstr_desc =
38-
Pstr_eval ({pexp_desc =
36+
let load_constant_string = function
37+
| {Parsetree.pexp_desc =
3938
#if OCAML_VERSION < (4,3,0)
40-
Pexp_constant (Const_string (text, _))
39+
Pexp_constant (Const_string (text, _))
4140
#elif OCAML_VERSION < (4,11,0)
42-
Pexp_constant (Pconst_string (text, _))
41+
Pexp_constant (Pconst_string (text, _))
4342
#else
44-
Pexp_constant (Pconst_string (text, _, _))
43+
Pexp_constant (Pconst_string (text, _, _))
4544
#endif
46-
; pexp_loc = loc; _}, _); _}] ->
47-
Some (text, loc)
45+
; pexp_loc = loc; _} ->
46+
Some (text , loc)
47+
| _ -> None
48+
49+
let load_payload = function
50+
| Parsetree.PStr [ { pstr_desc = Pstr_eval (constant_string, _); _ } ] ->
51+
load_constant_string constant_string
52+
| _ -> None
53+
54+
let load_alert_name name = (Longident.last name.Location.txt)
55+
56+
let load_alert_name_and_payload = function
57+
| Parsetree.PStr
58+
[ { pstr_desc = Pstr_eval ({ pexp_desc = expression; _ }, _); _ } ] -> (
59+
match expression with
60+
| Pexp_apply ({ pexp_desc = Pexp_ident name; _ }, [ (_, payload) ]) ->
61+
Some (load_alert_name name, load_constant_string payload)
62+
| Pexp_ident name -> Some (load_alert_name name, None)
63+
| _ -> None)
4864
| _ -> None
4965

5066
#if OCAML_VERSION >= (4,8,0)
@@ -62,8 +78,8 @@ type parsed_attribute =
6278
[ `Text of payload (** Standalone comment. *)
6379
| `Doc of payload (** Attached comment. *)
6480
| `Stop of Location.t (** [(**/**)]. *)
65-
| `Deprecated of payload option * Location.t
66-
(** [\[@@deprecated\]] attribute. *) ]
81+
| `Alert of string * payload option * Location.t
82+
(** [`Alert (name, payload, loc)] is for [\[@@alert name "payload"\]] attributes. *) ]
6783

6884
(** Recognize an attribute. *)
6985
let parse_attribute : Parsetree.attribute -> parsed_attribute option =
@@ -80,7 +96,12 @@ let parse_attribute : Parsetree.attribute -> parsed_attribute option =
8096
| Some p -> Some (`Doc p)
8197
| None -> None)
8298
| "deprecated" | "ocaml.deprecated" ->
83-
Some (`Deprecated ((load_payload attr_payload), attr_loc))
99+
Some (`Alert ("deprecated", (load_payload attr_payload), attr_loc))
100+
| "alert" | "ocaml.alert" ->
101+
(match load_alert_name_and_payload attr_payload with
102+
Some (name, payload) ->
103+
Some (`Alert (name, payload, attr_loc))
104+
| None -> None)
84105
| _ -> None
85106

86107
let is_stop_comment attr =
@@ -110,8 +131,8 @@ let attached internal_tags parent attrs =
110131
|> Error.raise_parser_warnings
111132
in
112133
loop (List.rev_append ast_docs acc_docs) acc_alerts rest
113-
| Some (`Deprecated (p, loc)) ->
114-
let elt = mk_alert_payload ~loc "deprecated" p in
134+
| Some (`Alert (name, p, loc)) ->
135+
let elt = mk_alert_payload ~loc name p in
115136
loop acc_docs (elt :: acc_alerts) rest
116137
| Some (`Text _ | `Stop _) | None -> loop acc_docs acc_alerts rest)
117138
| [] -> (List.rev acc_docs, List.rev acc_alerts)
@@ -150,9 +171,9 @@ let standalone parent (attr : Parsetree.attribute) :
150171
let doc, () = read_string_comment Semantics.Expect_none parent loc str in
151172
Some (`Docs doc)
152173
| Some (`Doc _) -> None
153-
| Some (`Deprecated (_, attr_loc)) ->
174+
| Some (`Alert (name, _, attr_loc)) ->
154175
let w =
155-
Error.make "Deprecated attribute not expected here."
176+
Error.make "Alert %s not expected here." name
156177
(read_location attr_loc)
157178
in
158179
Error.raise_warning w;
@@ -186,10 +207,10 @@ let extract_top_comment internal_tags ~classify parent items =
186207
match parse_attribute attr with
187208
| Some (`Text _ as p) -> p
188209
| Some (`Doc _) -> `Skip (* Unexpected, silently ignore *)
189-
| Some (`Deprecated (p, attr_loc)) ->
210+
| Some (`Alert (name, p, attr_loc)) ->
190211
let p = match p with Some (p, _) -> Some p | None -> None in
191212
let attr_loc = read_location attr_loc in
192-
`Alert (Location_.at attr_loc (`Tag (`Alert ("deprecated", p))))
213+
`Alert (Location_.at attr_loc (`Tag (`Alert (name, p))))
193214
| Some (`Stop _) | None -> `Skip)
194215
| Some `Open -> `Skip
195216
| None -> `Return

‎test/generators/cases/alerts.mli‎

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -27,3 +27,22 @@ module Top2 : sig
2727

2828
(** Top-comment. *)
2929
end
30+
31+
(* Deprecated alert tag. *)
32+
33+
val d : int
34+
[@@alert deprecated "A deprecated alert d"]
35+
36+
val d2 : int
37+
[@@alert deprecated]
38+
39+
(* Custom alert tag. *)
40+
41+
val e : int
42+
[@@alert e "an alert"]
43+
44+
(* Custom alert tag without payload. *)
45+
46+
val f : int
47+
[@@alert f]
48+

‎test/generators/html/Alerts.html‎

Lines changed: 46 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -71,6 +71,52 @@ <h1>Module <code><span>Alerts</span></code></h1>
7171
</code>
7272
</div><div class="spec-doc"><p>Top-comment.</p></div>
7373
</div>
74+
<div class="odoc-spec">
75+
<div class="spec value" id="val-d" class="anchored">
76+
<a href="#val-d" class="anchor"></a>
77+
<code><span><span class="keyword">val</span> d : int</span></code>
78+
</div>
79+
<div class="spec-doc">
80+
<ul class="at-tags">
81+
<li class="deprecated"><span class="at-tag">deprecated</span>
82+
A deprecated alert d
83+
</li>
84+
</ul>
85+
</div>
86+
</div>
87+
<div class="odoc-spec">
88+
<div class="spec value" id="val-d2" class="anchored">
89+
<a href="#val-d2" class="anchor"></a>
90+
<code><span><span class="keyword">val</span> d2 : int</span></code>
91+
</div>
92+
<div class="spec-doc">
93+
<ul class="at-tags">
94+
<li class="deprecated"><span class="at-tag">deprecated</span> </li>
95+
</ul>
96+
</div>
97+
</div>
98+
<div class="odoc-spec">
99+
<div class="spec value" id="val-e" class="anchored">
100+
<a href="#val-e" class="anchor"></a>
101+
<code><span><span class="keyword">val</span> e : int</span></code>
102+
</div>
103+
<div class="spec-doc">
104+
<ul class="at-tags">
105+
<li class="alert"><span class="at-tag">alert</span> e an alert</li>
106+
</ul>
107+
</div>
108+
</div>
109+
<div class="odoc-spec">
110+
<div class="spec value" id="val-f" class="anchored">
111+
<a href="#val-f" class="anchor"></a>
112+
<code><span><span class="keyword">val</span> f : int</span></code>
113+
</div>
114+
<div class="spec-doc">
115+
<ul class="at-tags">
116+
<li class="alert"><span class="at-tag">alert</span> f</li>
117+
</ul>
118+
</div>
119+
</div>
74120
</div>
75121
</body>
76122
</html>

‎test/generators/latex/Alerts.tex‎

Lines changed: 20 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -20,5 +20,25 @@ \section{Module \ocamlinlinecode{Alerts}}\label{module-Alerts}%
2020
\label{module-Alerts-module-Top2}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Alerts-module-Top2]{\ocamlinlinecode{Top2}}}\ocamlcodefragment{ : \ocamltag{keyword}{sig}}\begin{ocamlindent}\end{ocamlindent}%
2121
\ocamlcodefragment{\ocamltag{keyword}{end}}\begin{ocamlindent}Top-comment.\end{ocamlindent}%
2222
\medbreak
23+
\label{module-Alerts-val-d}\ocamlcodefragment{\ocamltag{keyword}{val} d : int}\begin{ocamlindent}\begin{description}\kern-\topsep
24+
\makeatletter\advance\@topsepadd-\topsep\makeatother% topsep is hardcoded
25+
\item[{deprecated}]{A deprecated alert d}\end{description}%
26+
\end{ocamlindent}%
27+
\medbreak
28+
\label{module-Alerts-val-d2}\ocamlcodefragment{\ocamltag{keyword}{val} d2 : int}\begin{ocamlindent}\begin{description}\kern-\topsep
29+
\makeatletter\advance\@topsepadd-\topsep\makeatother% topsep is hardcoded
30+
\item[{deprecated}]{}\end{description}%
31+
\end{ocamlindent}%
32+
\medbreak
33+
\label{module-Alerts-val-e}\ocamlcodefragment{\ocamltag{keyword}{val} e : int}\begin{ocamlindent}\begin{description}\kern-\topsep
34+
\makeatletter\advance\@topsepadd-\topsep\makeatother% topsep is hardcoded
35+
\item[{alert}]{e an alert}\end{description}%
36+
\end{ocamlindent}%
37+
\medbreak
38+
\label{module-Alerts-val-f}\ocamlcodefragment{\ocamltag{keyword}{val} f : int}\begin{ocamlindent}\begin{description}\kern-\topsep
39+
\makeatletter\advance\@topsepadd-\topsep\makeatother% topsep is hardcoded
40+
\item[{alert}]{f}\end{description}%
41+
\end{ocamlindent}%
42+
\medbreak
2343

2444

‎test/generators/man/Alerts.3o‎

Lines changed: 28 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -45,4 +45,32 @@ Top-comment\.
4545
.ti +2
4646
Top-comment\.
4747
.nf
48+
.sp
49+
\f[CB]val\fR d : int
50+
.fi
51+
.br
52+
.ti +2
53+
@deprecated: A deprecated alert d
54+
.nf
55+
.sp
56+
\f[CB]val\fR d2 : int
57+
.fi
58+
.br
59+
.ti +2
60+
@deprecated:
61+
.nf
62+
.sp
63+
\f[CB]val\fR e : int
64+
.fi
65+
.br
66+
.ti +2
67+
@alert: e an alert
68+
.nf
69+
.sp
70+
\f[CB]val\fR f : int
71+
.fi
72+
.br
73+
.ti +2
74+
@alert: f
75+
.nf
4876

0 commit comments

Comments
 (0)