Skip to content

Commit

Permalink
fix generated html for conjunctive types
Browse files Browse the repository at this point in the history
  • Loading branch information
@Octachron
Octachron committed Apr 26, 2019
1 parent 05241eb commit 2664304
Show file tree
Hide file tree
Showing 4 changed files with 95 additions and 8 deletions.
44 changes: 36 additions & 8 deletions src/html/generator.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -72,19 +72,33 @@ struct
let elements =
list_concat_map t.elements ~sep:(keyword " | ") ~f:(function
| Model.Lang.TypeExpr.Polymorphic_variant.Type te -> type_expr te
| Constructor {name; arguments; _} ->
| Constructor {constant; name; arguments; _} ->
let constr = "`" ^ name in
match arguments with
| [] -> [ Html.txt constr ]
| _ ->
(* Multiple arguments in a polymorphic variant constructor correspond
to a conjunction of types, not a product: [`Lbl int&float].
If constant is [true], the conjunction starts with an empty type,
for instance [`Lbl &int].
*)
let wrapped_type_expr =
(* type conjunction in Reason is printed as `Lbl (t1)&(t2)` *)
if Syntax.Type.Variant.parenthesize_params then
fun x -> Html.txt "(" :: type_expr x @ [Html.txt ")"]
else
fun x -> type_expr x
in
let arguments =
list_concat_map
arguments
~sep:(Html.txt Syntax.Type.Tuple.element_separator)
~f:type_expr
~sep:(Html.txt " & ")
~f:wrapped_type_expr
in
let arguments =
if constant then Html.txt "& " :: arguments else arguments in
if Syntax.Type.Variant.parenthesize_params
then Html.txt (constr ^ "(") :: arguments @ [ Html.txt ")" ]
then Html.txt constr :: arguments
else Html.txt (constr ^ " of ") :: arguments
)
in
Expand Down Expand Up @@ -423,21 +437,35 @@ struct
match item with
| Model.Lang.TypeExpr.Polymorphic_variant.Type te ->
"unknown", [Html.code (type_expr te)], None
| Constructor {name; arguments; doc; _} ->
| Constructor {constant; name; arguments; doc; _} ->
let cstr = "`" ^ name in
"constructor",
begin match arguments with
| [] -> [Html.code [ Html.txt cstr ]]
| _ ->
(* Multiple arguments in a polymorphic variant constructor correspond
to a conjunction of types, not a product: [`Lbl int&float].
If constant is [true], the conjunction starts with an empty type,
for instance [`Lbl &int].
*)
let wrapped_type_expr =
(* type conjunction in Reason is printed as `Lbl (t1)&(t2)` *)
if Syntax.Type.Variant.parenthesize_params then
fun x -> Html.txt "(" :: type_expr x @ [Html.txt ")"]
else
fun x -> type_expr x
in
let params = list_concat_map arguments
~sep:(keyword Syntax.Type.Tuple.element_separator)
~f:type_expr
~sep:(keyword " & ")
~f:wrapped_type_expr
in
let params =
if constant then keyword "& " :: params else params in
[ Html.code (
Html.txt cstr ::
(
if Syntax.Type.Variant.parenthesize_params
then Html.txt "(" :: params @ [ Html.txt ")" ]
then params
else keyword " of " :: params
)
)
Expand Down
5 changes: 5 additions & 0 deletions test/html/cases/type.mli
View file
Original file line number Diff line number Diff line change
Expand Up @@ -126,3 +126,8 @@ and recursive = B of mutually

(* Not a type, but analogous to extensions. *)
exception Foo of int * int

(* Conjunctive types *)
type empty_conj= X: [< `X of & int * float & float * int ] -> empty_conj

type conj = X: [< `X of int & float] -> conj
26 changes: 26 additions & 0 deletions test/html/expect/test_package+ml/Type/index.html
View file
Original file line number Diff line number Diff line change
Expand Up @@ -389,6 +389,32 @@ <h1>
<a href="#exception-Foo" class="anchor"></a><code><span class="keyword">exception </span></code><code><span class="exception">Foo</span><span class="keyword"> of </span>int<span class="keyword"> * </span>int</code>
</dt>
</dl>
<dl>
<dt class="spec type" id="type-empty_conj">
<a href="#type-empty_conj" class="anchor"></a><code><span class="keyword">type </span>empty_conj</code><code><span class="keyword"> = </span></code>
<table class="variant">
<tbody>
<tr id="type-empty_conj.X" class="anchored">
<td class="def constructor">
<a href="#type-empty_conj.X" class="anchor"></a><code><span class="keyword">| </span></code><code><span class="constructor">X</span><span class="keyword"> : </span>[&lt; `X of &amp; int<span class="keyword"> * </span>float &amp; float<span class="keyword"> * </span>int ] <span>-&gt;</span> <a href="index.html#type-empty_conj">empty_conj</a></code>
</td>
</tr>
</tbody>
</table>
</dt>
<dt class="spec type" id="type-conj">
<a href="#type-conj" class="anchor"></a><code><span class="keyword">type </span>conj</code><code><span class="keyword"> = </span></code>
<table class="variant">
<tbody>
<tr id="type-conj.X" class="anchored">
<td class="def constructor">
<a href="#type-conj.X" class="anchor"></a><code><span class="keyword">| </span></code><code><span class="constructor">X</span><span class="keyword"> : </span>[&lt; `X of int &amp; float ] <span>-&gt;</span> <a href="index.html#type-conj">conj</a></code>
</td>
</tr>
</tbody>
</table>
</dt>
</dl>
</div>
</body>
</html>
28 changes: 28 additions & 0 deletions test/html/expect/test_package+re/Type/index.html
View file
Original file line number Diff line number Diff line change
Expand Up @@ -395,6 +395,34 @@ <h1>
<a href="#exception-Foo" class="anchor"></a><code><span class="keyword">exception </span></code><code><span class="exception">Foo</span>(int<span class="keyword">, </span>int)</code><span class="keyword">;</span>
</dt>
</dl>
<dl>
<dt class="spec type" id="type-empty_conj">
<a href="#type-empty_conj" class="anchor"></a><code><span class="keyword">type </span>empty_conj</code><code><span class="keyword"> = </span></code>
<table class="variant">
<tbody>
<tr id="type-empty_conj.X" class="anchored">
<td class="def constructor">
<a href="#type-empty_conj.X" class="anchor"></a><code><span class="keyword">| </span></code><code><span class="constructor">X</span>([&lt; `X&amp; ((int<span class="keyword">, </span>float)) &amp; ((float<span class="keyword">, </span>int)) ]) : <a href="index.html#type-empty_conj">empty_conj</a></code>
</td>
</tr>
</tbody>
</table>
<span class="keyword">;</span>
</dt>
<dt class="spec type" id="type-conj">
<a href="#type-conj" class="anchor"></a><code><span class="keyword">type </span>conj</code><code><span class="keyword"> = </span></code>
<table class="variant">
<tbody>
<tr id="type-conj.X" class="anchored">
<td class="def constructor">
<a href="#type-conj.X" class="anchor"></a><code><span class="keyword">| </span></code><code><span class="constructor">X</span>([&lt; `X(int) &amp; (float) ]) : <a href="index.html#type-conj">conj</a></code>
</td>
</tr>
</tbody>
</table>
<span class="keyword">;</span>
</dt>
</dl>
</div>
</body>
</html>

0 comments on commit 2664304

Please sign in to comment.