Bug fixes

src/document/comment.ml

@@ -34,8 +34,6 @@ module Reference = struct
     | `Alias (_, r) -> render_resolved (r :> t)
     | `AliasModuleType (_, r) -> render_resolved (r :> t)
     | `Module (r, s) -> render_resolved (r :> t) ^ "." ^ ModuleName.to_string s
-    | `Canonical (_, `Resolved r) -> render_resolved (r :> t)
-    | `Canonical (p, _) -> render_resolved (p :> t)
     | `Hidden p -> render_resolved (p :> t)
     | `ModuleType (r, s) ->
         render_resolved (r :> t) ^ "." ^ ModuleTypeName.to_string s

src/document/generator.ml

@@ -1615,18 +1615,19 @@ module Make (Syntax : SYNTAX) = struct
       in
       let status = if decl_hidden then `Inline else t.status in
 
-      let include_decl =
-        match t.decl with
-        | Odoc_model.Lang.Include.Alias mod_path ->
-            Link.from_path (mod_path :> Paths.Path.t)
-        | ModuleType mt -> umty mt
-      in
-
       let _, content = signature t.expansion.content in
       let summary =
-        O.render
-          (O.keyword "include" ++ O.txt " " ++ include_decl
-          ++ if Syntax.Mod.include_semicolon then O.keyword ";" else O.noop)
+        if decl_hidden then O.render (O.keyword "include" ++ O.txt " ...")
+        else
+          let include_decl =
+            match t.decl with
+            | Odoc_model.Lang.Include.Alias mod_path ->
+                Link.from_path (mod_path :> Paths.Path.t)
+            | ModuleType mt -> umty mt
+          in
+          O.render
+            (O.keyword "include" ++ O.txt " " ++ include_decl
+            ++ if Syntax.Mod.include_semicolon then O.keyword ";" else O.noop)
       in
       let content = { Include.content; status; summary } in
       let attr = [ "include" ] in

src/html/generator.ml

@@ -295,29 +295,34 @@ and items ~resolve l : item Html.elt list =
     | Include { attr; anchor; doc; content = { summary; status; content } }
       :: rest ->
         let doc = spec_doc_div ~resolve doc in
-        let included_html = (items content :> any Html.elt list) in
+        let included_html = (items content :> item Html.elt list) in
         let a_class =
           if List.length content = 0 then [ "odoc-include"; "shadowed-include" ]
           else [ "odoc-include" ]
         in
-        let content =
+        let content : item Html.elt list =
           let details ~open' =
             let open' = if open' then [ Html.a_open () ] else [] in
             let summary =
               let extra_attr, extra_class, anchor_link = mk_anchor anchor in
               let a = spec_class (attr @ extra_class) @ extra_attr in
               Html.summary ~a @@ anchor_link @ source (inline ~resolve) summary
             in
-            [ Html.details ~a:open' summary included_html ]
+            let inner =
+              [
+                Html.details ~a:open' summary
+                  (included_html :> any Html.elt list);
+              ]
+            in
+            [ Html.div ~a:[ Html.a_class a_class ] (doc @ inner) ]
           in
           match status with
-          | `Inline -> included_html
+          | `Inline -> doc @ included_html
           | `Closed -> details ~open':false
           | `Open -> details ~open':true
           | `Default -> details ~open':!Tree.open_details
         in
-        let inc = [ Html.div ~a:[ Html.a_class a_class ] (doc @ content) ] in
-        (continue_with [@tailcall]) rest inc
+        (continue_with [@tailcall]) rest content
     | Declaration { Item.attr; anchor; content; doc } :: rest ->
         let extra_attr, extra_class, anchor_link = mk_anchor anchor in
         let a = spec_class (attr @ extra_class) @ extra_attr in

src/loader/cmt.ml

@@ -546,22 +546,14 @@ and read_include env parent incl =
       umty_of_mty mty
   in
   let content, shadowed = Cmi.read_signature_noenv env parent (Odoc_model.Compat.signature incl.incl_type) in
-  let rec contains_signature = function
-    | ModuleType.U.Signature _ -> true
-    | Path _ -> false
-    | With (_, w_expr) -> contains_signature w_expr
-    | TypeOf _ -> false
-  in 
+  let expansion = { content; shadowed; } in
   match decl_modty with
-  | Some m when not (contains_signature m) ->
+  | Some m ->
     let decl = ModuleType m in
-    let expansion = { content; shadowed; } in
     [Include {parent; doc; decl; expansion; status; strengthened=None; loc }]
-  | Some (ModuleType.U.Signature { items; _ }) ->
-    items
-  | _ ->
+  | _ -> 
     content.items
-
+    
 and read_open env parent o =
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
   let doc = Doc_attr.attached_no_tag container o.open_attributes in

src/loader/cmti.ml

@@ -269,11 +269,15 @@ let read_type_declarations env parent rec_flag decls =
     let open Signature in
     List.fold_left
       (fun (acc, recursive) decl ->
-        let comments =
-          Doc_attr.standalone_multiple container decl.typ_attributes in
-         let comments = List.map (fun com -> Comment com) comments in
-         let decl = read_type_declaration env parent decl in
-         ((Type (recursive, decl)) :: (List.rev_append comments acc), And))
+        if Btype.is_row_name (Ident.name decl.typ_id)
+        then (acc, recursive)
+        else begin
+          let comments =
+            Doc_attr.standalone_multiple container decl.typ_attributes in
+           let comments = List.map (fun com -> Comment com) comments in
+           let decl = read_type_declaration env parent decl in
+           ((Type (recursive, decl)) :: (List.rev_append comments acc), And)
+        end)
       ([], rec_flag) decls
     |> fst
   in
@@ -743,29 +747,12 @@ and read_include env parent incl =
   let doc, status = Doc_attr.attached Odoc_model.Semantics.Expect_status container incl.incl_attributes in
   let content, shadowed = Cmi.read_signature_noenv env parent (Odoc_model.Compat.signature incl.incl_type) in
   let expr = read_module_type env parent container incl.incl_mod in
-  let rec contains_signature = function
-    | ModuleType.U.Signature _ -> true
-    | Path _ -> false
-    | With (_, w_expr) -> contains_signature w_expr
-    | TypeOf _ -> false
-  in
-  (* inline type or module substitution is tricky to inline, because the
-     scope of the substitution is to the end of the signature being inlined.
-     If we've got one of those, we fall back to inlining the compiler-computed signature *)
-  let is_inlinable items =
-    not (List.exists
-          (function
-           | Signature.TypeSubstitution _ -> true
-           | ModuleSubstitution _ -> true
-           | _ -> false) items)
-  in
-  match Odoc_model.Lang.umty_of_mty expr with
-  | Some uexpr when not (contains_signature uexpr) ->
+  let umty = Odoc_model.Lang.umty_of_mty expr in 
+  let expansion = { content; shadowed; } in
+  match umty with
+  | Some uexpr ->
     let decl = Include.ModuleType uexpr in
-    let expansion = { content; shadowed; } in
     [Include {parent; doc; decl; expansion; status; strengthened=None; loc }]
-  | Some ModuleType.U.Signature { items; _ } when is_inlinable items ->
-    items
   | _ ->
     content.items
 

src/loader/ident_env.cppo.ml

@@ -156,6 +156,12 @@ let extract_extended_open o =
 #endif
 
 
+let filter_map f x =
+  List.rev
+  @@ List.fold_left
+       (fun acc x -> match f x with Some x -> x :: acc | None -> acc)
+       [] x
+
 let rec extract_signature_tree_items hide_item items =
   let open Typedtree in
   match items with
@@ -164,7 +170,10 @@ let rec extract_signature_tree_items hide_item items =
 #else
   | { sig_desc = Tsig_type (_, decls); _} :: rest ->
 #endif
-    List.map (fun decl -> `Type (decl.typ_id, hide_item))
+    filter_map (fun decl ->
+      if Btype.is_row_name (Ident.name decl.typ_id)
+      then None
+      else Some (`Type (decl.typ_id, hide_item)))
       decls @ extract_signature_tree_items hide_item rest
 
 #if OCAML_VERSION >= (4,10,0)

src/model/paths.ml

@@ -914,10 +914,6 @@ module Reference = struct
           else
             (Path.Resolved.ModuleType.identifier sub :> Identifier.Signature.t)
       | `Module (m, n) -> `Module (parent_signature_identifier m, n)
-      | `Canonical (_, `Resolved r) ->
-          parent_signature_identifier (r : module_ :> signature)
-      | `Canonical (r, _) ->
-          parent_signature_identifier (r : module_ :> signature)
       | `ModuleType (m, s) -> `ModuleType (parent_signature_identifier m, s)
 
     and parent_type_identifier : datatype -> Identifier.DataType.t = function
@@ -932,8 +928,8 @@ module Reference = struct
 
     and parent_identifier : parent -> Identifier.Parent.t = function
       | `Identifier id -> id
-      | ( `Hidden _ | `Alias _ | `AliasModuleType _ | `Module _ | `Canonical _
-        | `ModuleType _ ) as sg ->
+      | (`Hidden _ | `Alias _ | `AliasModuleType _ | `Module _ | `ModuleType _)
+        as sg ->
           (parent_signature_identifier sg :> Identifier.Parent.t)
       | `Type _ as t -> (parent_type_identifier t :> Identifier.Parent.t)
       | (`Class _ | `ClassType _) as c ->
@@ -942,14 +938,14 @@ module Reference = struct
     and label_parent_identifier : label_parent -> Identifier.LabelParent.t =
       function
       | `Identifier id -> id
-      | ( `Hidden _ | `Alias _ | `AliasModuleType _ | `Module _ | `Canonical _
-        | `ModuleType _ | `Type _ | `Class _ | `ClassType _ ) as r ->
+      | ( `Hidden _ | `Alias _ | `AliasModuleType _ | `Module _ | `ModuleType _
+        | `Type _ | `Class _ | `ClassType _ ) as r ->
           (parent_identifier r :> Identifier.LabelParent.t)
 
     and identifier : t -> Identifier.t = function
       | `Identifier id -> id
-      | ( `Alias _ | `AliasModuleType _ | `Module _ | `Canonical _ | `Hidden _
-        | `Type _ | `Class _ | `ClassType _ | `ModuleType _ ) as r ->
+      | ( `Alias _ | `AliasModuleType _ | `Module _ | `Hidden _ | `Type _
+        | `Class _ | `ClassType _ | `ModuleType _ ) as r ->
           (label_parent_identifier r :> Identifier.t)
       | `Field (p, n) -> `Field (parent_identifier p, n)
       | `Constructor (s, n) -> `Constructor (parent_type_identifier s, n)

src/model/paths_types.ml

@@ -590,8 +590,7 @@ and Resolved_reference : sig
     [ `Identifier of Identifier.path_module
     | `Hidden of module_
     | `Alias of Resolved_path.module_ * module_
-    | `Module of signature * ModuleName.t
-    | `Canonical of module_ * Reference.module_ ]
+    | `Module of signature * ModuleName.t ]
   (** @canonical Odoc_model.Paths.Reference.Resolved.Module.t *)
 
   (* Signature is [ module | moduletype ] *)
@@ -600,7 +599,6 @@ and Resolved_reference : sig
     | `Hidden of module_
     | `Alias of Resolved_path.module_ * module_
     | `Module of signature * ModuleName.t
-    | `Canonical of module_ * Reference.module_
     | `ModuleType of signature * ModuleTypeName.t
     | `AliasModuleType of Resolved_path.module_type * module_type ]
   (** @canonical Odoc_model.Paths.Reference.Resolved.Signature.t *)
@@ -618,7 +616,6 @@ and Resolved_reference : sig
     | `AliasModuleType of Resolved_path.module_type * module_type
     | `Module of signature * ModuleName.t
     | `Hidden of module_
-    | `Canonical of module_ * Reference.module_
     | `ModuleType of signature * ModuleTypeName.t
     | `Class of signature * ClassName.t
     | `ClassType of signature * ClassTypeName.t
@@ -633,7 +630,6 @@ and Resolved_reference : sig
     | `AliasModuleType of Resolved_path.module_type * module_type
     | `Module of signature * ModuleName.t
     | `Hidden of module_
-    | `Canonical of module_ * Reference.module_
     | `ModuleType of signature * ModuleTypeName.t
     | `Class of signature * ClassName.t
     | `ClassType of signature * ClassTypeName.t
@@ -716,7 +712,6 @@ and Resolved_reference : sig
     | `AliasModuleType of Resolved_path.module_type * module_type
     | `Module of signature * ModuleName.t
     | `Hidden of module_
-    | `Canonical of module_ * Reference.module_
     | `ModuleType of signature * ModuleTypeName.t
     | `Type of signature * TypeName.t
     | `Constructor of datatype * ConstructorName.t

src/model_desc/paths_desc.ml

@@ -298,11 +298,6 @@ module General_paths = struct
   and resolved_reference : rr t =
     Variant
       (function
-      | `Canonical (x1, x2) ->
-          C
-            ( "`Canonical",
-              ((x1 :> rr), (x2 :> r)),
-              Pair (resolved_reference, reference) )
       | `Class (x1, x2) ->
           C
             ( "`Class",

src/xref2/component.ml

@@ -1398,11 +1398,6 @@ module Fmt = struct
           (x :> Odoc_model.Paths.Path.Resolved.t)
           model_resolved_reference
           (y :> Odoc_model.Paths.Reference.Resolved.t)
-    | `Canonical (x, y) ->
-        Format.fprintf ppf "canonical(%a,%a)" model_resolved_reference
-          (x :> t)
-          model_reference
-          (y :> Odoc_model.Paths.Reference.t)
     | `Label (parent, name) ->
         Format.fprintf ppf "%a.%s" model_resolved_reference
           (parent :> t)
@@ -2328,12 +2323,12 @@ module Of_Lang = struct
   and module_of_module_substitution ident_map
       (t : Odoc_model.Lang.ModuleSubstitution.t) =
     let manifest = module_path ident_map t.manifest in
-    let canonical = Some manifest in
+    let canonical = None in
     {
       Module.doc = docs ident_map t.doc;
       type_ = Alias (manifest, None);
       canonical;
-      hidden = true;
+      hidden = false;
     }
 
   and signature : _ -> Odoc_model.Lang.Signature.t -> Signature.t =

src/xref2/cpath.ml

@@ -191,11 +191,11 @@ and is_resolved_module_hidden :
     | `Identifier _ -> false
     | `Hidden _ -> true
     | `Canonical (_, `Resolved _) -> false
-    | `Canonical (p, _) -> weak_canonical_test || inner p
-    | `Substituted p | `Apply (p, _) -> inner p
+    | `Canonical (p, _) -> (not weak_canonical_test) && inner p
+    | `Substituted p -> inner p
     | `Module (p, _) -> is_resolved_parent_hidden ~weak_canonical_test p
     | `Subst (p1, p2) -> is_resolved_module_type_hidden p1 || inner p2
-    | `Alias (p1, p2) -> inner p1 || inner p2
+    | `Alias (p1, p2) | `Apply (p1, p2) -> inner p1 || inner p2
     | `OpaqueModule m -> inner m
   in
   inner
@@ -281,15 +281,11 @@ let rec resolved_module_of_resolved_module_reference :
   | `Identifier i -> `Identifier i
   | `Alias (_m1, _m2) -> failwith "gah"
   | `Hidden s -> `Hidden (resolved_module_of_resolved_module_reference s)
-  | `Canonical (m1, m2) ->
-      `Canonical
-        ( resolved_module_of_resolved_module_reference m1,
-          module_of_module_reference m2 )
 
 and resolved_module_of_resolved_signature_reference :
     Reference.Resolved.Signature.t -> Resolved.module_ = function
   | `Identifier (#Identifier.Module.t as i) -> `Identifier i
-  | (`Alias _ | `Canonical _ | `Module _ | `Hidden _) as r' ->
+  | (`Alias _ | `Module _ | `Hidden _) as r' ->
       resolved_module_of_resolved_module_reference r'
   | `ModuleType (_, n) ->
       failwith ("Not a module reference: " ^ ModuleTypeName.to_string n)

src/xref2/env.ml

@@ -119,14 +119,23 @@ end = struct
   let remove id t =
     let id = (id :> Identifier.t) in
     let name = Identifier.name id in
-    let l = StringMap.find name t in
+    let l =
+      try StringMap.find name t
+      with e ->
+        Format.eprintf "Failed to find %s\n%!" name;
+        raise e
+    in
     match
       List.filter
         (fun e ->
           not (Identifier.equal id (Component.Element.identifier e.elem)))
         l
     with
-    | [] -> StringMap.remove name t
+    | [] -> (
+        try StringMap.remove name t
+        with Not_found ->
+          Format.eprintf "Failed to find %s\n%!" name;
+          raise Not_found)
     | xs -> StringMap.add name xs (StringMap.remove name t)
 
   let find_by_name f name t =