diff --git a/src/document/generator.ml b/src/document/generator.ml index 6f5c509320..55f2cf8bcc 100644 --- a/src/document/generator.ml +++ b/src/document/generator.ml @@ -594,27 +594,6 @@ module Make (Syntax : SYNTAX) = struct O.documentedSrc (cstr ++ O.txt " " ++ O.keyword "of" ++ O.txt " ") @ record fields - let rec read_typ_exp typ_expr = - let open Lang.TypeExpr in - let open Paths.Path in - match typ_expr with - | Constr (p, ts) -> - is_hidden (p :> Paths.Path.t) - || List.exists (fun t -> read_typ_exp t) ts - | Poly (_, t) | Alias (t, _) -> read_typ_exp t - | Arrow (_, t, t2) -> read_typ_exp t || read_typ_exp t2 - | Tuple ts | Class (_, ts) -> List.exists (fun t -> read_typ_exp t) ts - | _ -> false - - let internal_cstr_arg t = - let open Lang.TypeDecl.Constructor in - let open Lang.TypeDecl.Field in - match t.args with - | Tuple type_exprs -> - List.exists (fun type_expr -> read_typ_exp type_expr) type_exprs - | Record fields -> - List.exists (fun field -> read_typ_exp field.type_) fields - let variant cstrs : DocumentedSrc.t = let constructor id args res = match Url.from_identifier ~stop_before:true id with @@ -634,7 +613,6 @@ module Make (Syntax : SYNTAX) = struct | _ :: _ -> let rows = cstrs - |> List.filter (fun cstr -> not (internal_cstr_arg cstr)) |> List.map (fun cstr -> let open Odoc_model.Lang.TypeDecl.Constructor in let url, attrs, code = diff --git a/src/xref2/link.ml b/src/xref2/link.ml index 2b9d9ca6b4..5370b1d516 100644 --- a/src/xref2/link.ml +++ b/src/xref2/link.ml @@ -365,6 +365,51 @@ and open_ env parent = function | { Odoc_model__Lang.Open.doc; _ } as open_ -> { open_ with doc = comment_docs env parent doc } +let warn_on_hidden_representation (id : Id.Type.t) + (r : Lang.TypeDecl.Representation.t) = + let open Paths.Identifier in + let rec internal_typ_exp typ_expr = + let open Lang.TypeExpr in + let open Paths.Path in + match typ_expr with + | Constr (p, ts) -> + is_hidden (p :> Paths.Path.t) + || List.exists (fun t -> internal_typ_exp t) ts + | Poly (_, t) | Alias (t, _) -> internal_typ_exp t + | Arrow (_, t, t2) -> internal_typ_exp t || internal_typ_exp t2 + | Tuple ts | Class (_, ts) -> List.exists (fun t -> internal_typ_exp t) ts + | _ -> false + in + + let internal_cstr_arg t = + let open Lang.TypeDecl.Constructor in + let open Lang.TypeDecl.Field in + match t.args with + | Tuple type_exprs -> + List.exists (fun type_expr -> internal_typ_exp type_expr) type_exprs + | Record fields -> + List.exists (fun field -> internal_typ_exp field.type_) fields + in + + let internal_field t = + let open Lang.TypeDecl.Field in + internal_typ_exp t.type_ + in + + let fmt_cfg = Component.Fmt.{ default with short_paths = true } in + match r with + | Variant constructors -> + if List.exists internal_cstr_arg constructors then + Lookup_failures.report_warning "@[<2>Hidden constructors in type '%a'@]" + Component.Fmt.(model_identifier fmt_cfg) + (id :> Id.any) + | Record fields -> + if List.exists internal_field fields then + Lookup_failures.report_warning "@[<2>Hidden fields in type '%a'@]" + Component.Fmt.(model_identifier fmt_cfg) + (id :> Id.any) + | Extensible -> () + let rec unit env t = let open Compilation_unit in let content = @@ -877,7 +922,12 @@ and type_decl : Env.t -> Id.Signature.t -> TypeDecl.t -> TypeDecl.t = | _ -> None in let representation = - Opt.map (type_decl_representation env parent) t.representation + Opt.map + (fun r -> + let r' = type_decl_representation env parent r in + warn_on_hidden_representation t.id r'; + r') + t.representation in let default = { t with source_loc; equation; doc; representation } in match hidden_path with diff --git a/test/generators/html/Stop_dead_link_doc.html b/test/generators/html/Stop_dead_link_doc.html index 034085e387..a6192f85b9 100644 --- a/test/generators/html/Stop_dead_link_doc.html +++ b/test/generators/html/Stop_dead_link_doc.html @@ -112,25 +112,87 @@

Module Stop_dead_link_doc

- type another_foo + type another_foo + = + +
    +
  1. + + | + Bar + of + {Another_Foo}1.t + + +
    2. +
- type another_bar + type another_bar + = + +
    +
  1. + + | + Bar + of + { + +
      +
    1. + + + field : {Another_Foo}1.t + ; + + +
      2. +
    } +
    2. +
- type another_foo_ + type another_foo_ + = + +
    +
  1. + | + Bar_ + of int * + {Another_Foo}1.t * int + + +
    2. +
- type another_bar_ + type another_bar_ + = + +
    +
  1. + | + Bar__ + of + {Another_Foo}1.t option + + + +
    2. +
diff --git a/test/generators/latex/Stop_dead_link_doc.tex b/test/generators/latex/Stop_dead_link_doc.tex index 8439d954ac..686fed05a2 100644 --- a/test/generators/latex/Stop_dead_link_doc.tex +++ b/test/generators/latex/Stop_dead_link_doc.tex @@ -20,9 +20,23 @@ \section{Module \ocamlinlinecode{Stop\_\allowbreak{}dead\_\allowbreak{}link\_\al \begin{ocamltabular}{p{1.000\textwidth}}\ocamlcodefragment{| \ocamltag{constructor}{Bar\_\allowbreak{}\_\allowbreak{}} \ocamltag{keyword}{of} \hyperref[module-Stop_dead_link_doc-module-Foo-type-t]{\ocamlinlinecode{Foo.\allowbreak{}t}} option}\label{module-Stop_dead_link_doc-type-bar_.Bar__}\\ \end{ocamltabular}% \\ -\label{module-Stop_dead_link_doc-type-another_foo}\ocamlcodefragment{\ocamltag{keyword}{type} another\_\allowbreak{}foo}\\ -\label{module-Stop_dead_link_doc-type-another_bar}\ocamlcodefragment{\ocamltag{keyword}{type} another\_\allowbreak{}bar}\\ -\label{module-Stop_dead_link_doc-type-another_foo_}\ocamlcodefragment{\ocamltag{keyword}{type} another\_\allowbreak{}foo\_\allowbreak{}}\\ -\label{module-Stop_dead_link_doc-type-another_bar_}\ocamlcodefragment{\ocamltag{keyword}{type} another\_\allowbreak{}bar\_\allowbreak{}}\\ +\label{module-Stop_dead_link_doc-type-another_foo}\ocamlcodefragment{\ocamltag{keyword}{type} another\_\allowbreak{}foo = }\\ +\begin{ocamltabular}{p{1.000\textwidth}}\ocamlcodefragment{| \ocamltag{constructor}{Bar} \ocamltag{keyword}{of} \hyperref[xref-unresolved]{\ocamlinlinecode{\{Another\_\allowbreak{}Foo\}1.\allowbreak{}t}}}\label{module-Stop_dead_link_doc-type-another_foo.Bar}\\ +\end{ocamltabular}% +\\ +\label{module-Stop_dead_link_doc-type-another_bar}\ocamlcodefragment{\ocamltag{keyword}{type} another\_\allowbreak{}bar = }\begin{ocamlindent}\ocamlcodefragment{| \ocamltag{constructor}{Bar} \ocamltag{keyword}{of} \{}\\ +\begin{ocamltabular}{p{1.000\textwidth}}\ocamlinlinecode{field : \hyperref[xref-unresolved]{\ocamlinlinecode{\{Another\_\allowbreak{}Foo\}1.\allowbreak{}t}};\allowbreak{}}\label{module-Stop_dead_link_doc-type-another_bar.field}\\ +\end{ocamltabular}% +\\ +\ocamlcodefragment{\}}\label{module-Stop_dead_link_doc-type-another_bar.Bar}\\ +\end{ocamlindent}% +\label{module-Stop_dead_link_doc-type-another_foo_}\ocamlcodefragment{\ocamltag{keyword}{type} another\_\allowbreak{}foo\_\allowbreak{} = }\\ +\begin{ocamltabular}{p{1.000\textwidth}}\ocamlcodefragment{| \ocamltag{constructor}{Bar\_\allowbreak{}} \ocamltag{keyword}{of} int * \hyperref[xref-unresolved]{\ocamlinlinecode{\{Another\_\allowbreak{}Foo\}1.\allowbreak{}t}} * int}\label{module-Stop_dead_link_doc-type-another_foo_.Bar_}\\ +\end{ocamltabular}% +\\ +\label{module-Stop_dead_link_doc-type-another_bar_}\ocamlcodefragment{\ocamltag{keyword}{type} another\_\allowbreak{}bar\_\allowbreak{} = }\\ +\begin{ocamltabular}{p{1.000\textwidth}}\ocamlcodefragment{| \ocamltag{constructor}{Bar\_\allowbreak{}\_\allowbreak{}} \ocamltag{keyword}{of} \hyperref[xref-unresolved]{\ocamlinlinecode{\{Another\_\allowbreak{}Foo\}1.\allowbreak{}t}} option}\label{module-Stop_dead_link_doc-type-another_bar_.Bar__}\\ +\end{ocamltabular}% +\\ diff --git a/test/generators/man/Stop_dead_link_doc.3o b/test/generators/man/Stop_dead_link_doc.3o index 940e6594ca..a1e04198cb 100644 --- a/test/generators/man/Stop_dead_link_doc.3o +++ b/test/generators/man/Stop_dead_link_doc.3o @@ -43,10 +43,33 @@ field : Foo\.t; | \f[CB]Bar__\fR \f[CB]of\fR Foo\.t option .br .sp -\f[CB]type\fR another_foo +\f[CB]type\fR another_foo = +.br +.ti +2 +| \f[CB]Bar\fR \f[CB]of\fR {Another_Foo}1\.t +.br .sp -\f[CB]type\fR another_bar +\f[CB]type\fR another_bar = +.br +.ti +2 +| \f[CB]Bar\fR \f[CB]of\fR { +.br +.ti +6 +field : {Another_Foo}1\.t; +.br +.ti +4 +} +.br .sp -\f[CB]type\fR another_foo_ +\f[CB]type\fR another_foo_ = +.br +.ti +2 +| \f[CB]Bar_\fR \f[CB]of\fR int * {Another_Foo}1\.t * int +.br .sp -\f[CB]type\fR another_bar_ +\f[CB]type\fR another_bar_ = +.br +.ti +2 +| \f[CB]Bar__\fR \f[CB]of\fR {Another_Foo}1\.t option +.br + diff --git a/test/xref2/hidden_representations.t/run.t b/test/xref2/hidden_representations.t/run.t new file mode 100644 index 0000000000..4afdf7435b --- /dev/null +++ b/test/xref2/hidden_representations.t/run.t @@ -0,0 +1,8 @@ + $ ocamlc -bin-annot -c test.mli + $ odoc compile test.cmti + $ odoc link test.odoc + File "test.odoc": + Warning: Hidden fields in type 'Test.u' + File "test.odoc": + Warning: Hidden constructors in type 'Test.t' + diff --git a/test/xref2/hidden_representations.t/test.mli b/test/xref2/hidden_representations.t/test.mli new file mode 100644 index 0000000000..a5ec51df7d --- /dev/null +++ b/test/xref2/hidden_representations.t/test.mli @@ -0,0 +1,12 @@ +module Hidden__ : sig + type t +end + +type t = + | Variant of int + | Hidden of Hidden__.t + +type u = + { not_hidden : int + ; hidden : Hidden__.t } +