stop rendering dead links

Signed-off-by: lubegasimon <lubegasimon73@gmail.com>

Author: lubegasimon

src/compat/odoc_compat.ml

@@ -1,7 +1,7 @@
 (**
-   Compatibility module reexporting ~equivalent functions based on the current
-   OCaml version
- *)
+  Compatibility module reexporting ~equivalent functions based on the current
+  OCaml version
+*)
 module String =
 struct
   include String

src/document/generator.ml

@@ -459,6 +459,27 @@ 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
@@ -476,6 +497,7 @@ 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 =
@@ -693,13 +715,15 @@ module Make (Syntax : SYNTAX) = struct
               | Variant cstrs -> variant cstrs
               | Record fields -> record fields
             in
-            O.documentedSrc
-              ( O.txt " = "
-              ++
-              if need_private then
-                O.keyword Syntax.Type.private_keyword ++ O.txt " "
-              else O.noop )
-            @ content
+            if List.length content > 0 then
+              O.documentedSrc
+                ( O.txt " = "
+                ++
+                if need_private then
+                  O.keyword Syntax.Type.private_keyword ++ O.txt " "
+                else O.noop )
+              @ content
+            else []
       in
       let tconstr =
         match t.equation.params with

src/loader/cmi.ml

@@ -23,9 +23,8 @@ open Odoc_model.Paths
 open Odoc_model.Lang
 open Odoc_model.Names
 
-module Env = Odoc_model.Ident_env
+module Env = Ident_env
 module Paths = Odoc_model.Paths
-module Ident_env = Odoc_model.Ident_env
 
 let opt_map f = function
   | None -> None

src/loader/cmi.mli

@@ -17,8 +17,6 @@
 
 
 module Paths = Odoc_model.Paths
-module Ident_env = Odoc_model.Ident_env
-
 
 
 val read_interface: Odoc_model.Paths.Identifier.ContainerPage.t -> string -> Odoc_model.Compat.signature ->

src/loader/cmt.ml

@@ -23,7 +23,7 @@ module OCamlPath = Path
 open Odoc_model.Paths
 open Odoc_model.Lang
 
-module Env = Odoc_model.Ident_env
+module Env = Ident_env
 
 
 let read_core_type env ctyp =

src/loader/cmti.ml

@@ -23,9 +23,8 @@ open Odoc_model.Paths
 open Odoc_model.Lang
 open Odoc_model.Names
 
-module Env = Odoc_model.Ident_env
+module Env = Ident_env
 module Paths = Odoc_model.Paths
-module Ident_env = Odoc_model.Ident_env
 
 let read_module_expr : (Ident_env.t -> Identifier.Signature.t -> Identifier.LabelParent.t -> Typedtree.module_expr -> ModuleType.expr) ref = ref (fun _ _ _ _ -> failwith "unset")
 

src/loader/cmti.mli

@@ -15,7 +15,6 @@
  *)
 
 module Paths = Odoc_model.Paths
-module Ident_env = Odoc_model.Ident_env
 
 val read_module_expr : (Ident_env.t -> Paths.Identifier.Signature.t -> Paths.Identifier.LabelParent.t -> Typedtree.module_expr -> Odoc_model.Lang.ModuleType.expr) ref
 val read_interface :

src/loader/doc_attr.ml

@@ -28,7 +28,7 @@ let empty : Odoc_model.Comment.docs = empty_body
 
 
 
-let load_payload : Parsetree.payload -> (string * Location.t) option = function
+let load_payload : Parsetree.payload -> string * Location.t = function
   | PStr [{pstr_desc =
       Pstr_eval ({pexp_desc =
 #if OCAML_MAJOR = 4 && OCAML_MINOR = 02
@@ -39,9 +39,21 @@ let load_payload : Parsetree.payload -> (string * Location.t) option = function
         Pexp_constant (Pconst_string (text, _, _))
 #endif
    ; pexp_loc = loc; _}, _); _}] ->
-    Some (text, loc)
-  | _ ->
-    None
+     (text, loc)
+  | _ -> assert false
+
+
+    let parse_attribute : Parsetree.attribute -> (string * Location.t) option = function
+    #if OCAML_MAJOR = 4 && OCAML_MINOR >= 08
+      | { attr_name = { Location.txt =
+          ("text" | "ocaml.text"); loc = _loc}; attr_payload; _ } -> begin
+    #else
+      | ({Location.txt =
+          ("text" | "ocaml.text"); loc = _loc}, attr_payload) -> begin
+    #endif
+      Some (load_payload attr_payload)
+        end
+      | _ -> None
 
 let attached parent attrs =
   let ocaml_deprecated = ref None in
@@ -56,7 +68,7 @@ let attached parent attrs =
           ("doc" | "ocaml.doc"); loc = _loc}, attr_payload) :: rest -> begin
 #endif
         match load_payload attr_payload with
-        | Some (str, loc) -> begin
+        | (str, loc) -> begin
             let start_pos = loc.Location.loc_start in
             let start_pos =
               {start_pos with pos_cnum = start_pos.pos_cnum + 3} in
@@ -70,7 +82,6 @@ let attached parent attrs =
             in
             loop false 0 (acc @ parsed) rest
           end
-        | None -> (* TODO *) assert false
       end
     | _ :: rest -> loop first nb_deprecated acc rest
     | [] -> begin
@@ -96,32 +107,15 @@ let read_string parent loc str : Odoc_model.Comment.docs_or_stop =
 
 let page = read_string
 
-let standalone parent
-    : Parsetree.attribute -> Odoc_model.Comment.docs_or_stop option =
-
-  function
-#if OCAML_MAJOR = 4 && OCAML_MINOR >= 08
-  | { attr_name = { Location.txt =
-        ("text" | "ocaml.text"); loc = _loc}; attr_payload; _ } -> begin
-#else
-  | ({Location.txt =
-        ("text" | "ocaml.text"); loc = _loc}, attr_payload) -> begin
-#endif
-      match load_payload attr_payload with
-      | Some ("/*", _loc) -> Some `Stop
-      | Some (str, loc) ->
-        let loc' =
-          { loc with
-            loc_start = { loc.loc_start with pos_cnum = loc.loc_start.pos_cnum + 3 } }
-        in
-        Some (read_string parent loc' str)
-      | None ->
-        (* TODO *)
-        assert false
-          (* let doc : Odoc_model.Comment.t =
-            Error (invalid_attribute_error parent loc) in
-            Some (Documentation doc) *)
-    end
+let standalone parent(attr : Parsetree.attribute): Odoc_model.Comment.docs_or_stop option = 
+  match parse_attribute attr with
+  | Some ("/*", _loc) -> Some `Stop
+  | Some (str, loc) ->
+    let loc' =
+      { loc with
+        loc_start = { loc.loc_start with pos_cnum = loc.loc_start.pos_cnum + 3 } }
+    in
+    Some (read_string parent loc' str)
   | _ -> None
 
 let standalone_multiple parent attrs =

src/loader/doc_attr.mli

@@ -22,6 +22,8 @@ module Paths = Odoc_model.Paths
 
 val empty : Odoc_model.Comment.docs
 
+val parse_attribute : Parsetree.attribute -> (string * Location.t) option
+
 val attached :
   Paths.Identifier.LabelParent.t ->
   Parsetree.attributes ->

src/loader/dune

@@ -1,3 +1,21 @@
+(rule
+ (targets ident_env.ml)
+ (deps
+  (:x ident_env.cppo.ml))
+ (action
+  (chdir
+   %{workspace_root}
+   (run %{bin:cppo} -V OCAML:%{ocaml_version} %{x} -o %{targets}))))
+
+(rule
+ (targets ident_env.mli)
+ (deps
+  (:x ident_env.cppo.mli))
+ (action
+  (chdir
+   %{workspace_root}
+   (run %{bin:cppo} -V OCAML:%{ocaml_version} %{x} -o %{targets}))))
+
 (library
  (name odoc_loader)
  (public_name odoc.loader)