IR model: items, allow multiple "kind"s (part of #601).

We simply use the `attr` pattern already present in
the IR model.

This also slightly tweaks some of the "kinds":

* `extension` becomes `type extension`
* `type-subst` becomes `type subst`
* `external` becomes `value external`
* `instance-variable` becomes `value instance-variable`

Fixes part of #601.

Author: dbuenzli

src/document/generator.ml

@@ -540,10 +540,10 @@ module Make (Syntax : SYNTAX) = struct
         @ O.documentedSrc
             (if Syntax.Type.type_def_semicolon then O.txt ";" else O.noop)
       in
-      let kind = Some "extension" in
+      let attr = [ "type"; "extension" ] in
       let anchor = None in
       let doc = Comment.to_ir t.doc in
-      Item.Declaration { kind; anchor; doc; content }
+      Item.Declaration { attr; anchor; doc; content }
 
     let exn (t : Odoc_model.Lang.Exception.t) =
       let cstr = constructor (t.id :> Paths.Identifier.t) t.args t.res in
@@ -553,10 +553,10 @@ module Make (Syntax : SYNTAX) = struct
         @ O.documentedSrc
             (if Syntax.Type.Exception.semicolon then O.txt ";" else O.noop)
       in
-      let kind = Some "exception" in
+      let attr = [ "exception" ] in
       let anchor = path_to_id t.id in
       let doc = Comment.to_ir t.doc in
-      Item.Declaration { kind; anchor; doc; content }
+      Item.Declaration { attr; anchor; doc; content }
 
     let polymorphic_variant ~type_ident
         (t : Odoc_model.Lang.TypeExpr.Polymorphic_variant.t) =
@@ -748,10 +748,10 @@ module Make (Syntax : SYNTAX) = struct
         @ O.documentedSrc
             (if Syntax.Type.type_def_semicolon then O.txt ";" else O.noop)
       in
-      let kind = Some (if is_substitution then "type-subst" else "type") in
+      let attr = "type" :: (if is_substitution then [ "subst" ] else []) in
       let anchor = path_to_id t.id in
       let doc = Comment.to_ir t.doc in
-      Item.Declaration { kind; anchor; doc; content }
+      Item.Declaration { attr; anchor; doc; content }
   end
 
   open Type_declaration
@@ -771,10 +771,10 @@ module Make (Syntax : SYNTAX) = struct
           ++ type_expr t.type_
           ++ if Syntax.Value.semicolon then O.txt ";" else O.noop )
       in
-      let kind = Some "value" in
+      let attr = [ "value" ] in
       let anchor = path_to_id t.id in
       let doc = Comment.to_ir t.doc in
-      Item.Declaration { kind; anchor; doc; content }
+      Item.Declaration { attr; anchor; doc; content }
 
     let external_ (t : Odoc_model.Lang.External.t) =
       let name = Paths.Identifier.name t.id in
@@ -786,10 +786,10 @@ module Make (Syntax : SYNTAX) = struct
           ++ type_expr t.type_
           ++ if Syntax.Type.External.semicolon then O.txt ";" else O.noop )
       in
-      let kind = Some "external" in
+      let attr = [ "value"; "external" ] in
       let anchor = path_to_id t.id in
       let doc = Comment.to_ir t.doc in
-      Item.Declaration { kind; anchor; doc; content }
+      Item.Declaration { attr; anchor; doc; content }
   end
 
   open Value
@@ -887,10 +887,10 @@ module Make (Syntax : SYNTAX) = struct
           ++ O.txt Syntax.Type.annotation_separator
           ++ type_expr t.type_ )
       in
-      let kind = Some "method" in
+      let attr = [ "method" ] in
       let anchor = path_to_id t.id in
       let doc = Comment.to_ir t.doc in
-      Item.Declaration { kind; anchor; doc; content }
+      Item.Declaration { attr; anchor; doc; content }
 
     let instance_variable (t : Odoc_model.Lang.InstanceVariable.t) =
       let name = Paths.Identifier.name t.id in
@@ -906,26 +906,26 @@ module Make (Syntax : SYNTAX) = struct
           ++ O.txt Syntax.Type.annotation_separator
           ++ type_expr t.type_ )
       in
-      let kind = Some "instance-variable" in
+      let attr = [ "value"; "instance-variable" ] in
       let anchor = path_to_id t.id in
       let doc = Comment.to_ir t.doc in
-      Item.Declaration { kind; anchor; doc; content }
+      Item.Declaration { attr; anchor; doc; content }
 
     let inherit_ cte =
       let content =
         O.documentedSrc (O.keyword "inherit" ++ O.txt " " ++ class_type_expr cte)
       in
-      let kind = Some "inherit" in
+      let attr = [ "inherit" ] in
       let anchor = None in
       let doc = [] in
-      Item.Declaration { kind; anchor; doc; content }
+      Item.Declaration { attr; anchor; doc; content }
 
     let constraint_ t1 t2 =
       let content = O.documentedSrc (format_constraints [ (t1, t2) ]) in
-      let kind = None in
+      let attr = [] in
       let anchor = None in
       let doc = [] in
-      Item.Declaration { kind; anchor; doc; content }
+      Item.Declaration { attr; anchor; doc; content }
 
     let class_signature (c : Lang.ClassSignature.t) =
       let rec loop l acc_items =
@@ -1002,10 +1002,10 @@ module Make (Syntax : SYNTAX) = struct
           (O.keyword "class" ++ O.txt " " ++ virtual_ ++ params ++ O.txt " ")
         @ cname @ cd
       in
-      let kind = Some "class" in
+      let attr = [ "class" ] in
       let anchor = path_to_id t.id in
       let doc = Comment.first_to_ir t.doc in
-      Item.Declaration { kind; anchor; doc; content }
+      Item.Declaration { attr; anchor; doc; content }
 
     let class_type (t : Odoc_model.Lang.ClassType.t) =
       let name = Paths.Identifier.name t.id in
@@ -1034,10 +1034,10 @@ module Make (Syntax : SYNTAX) = struct
           ++ virtual_ ++ params ++ O.txt " " )
         @ cname @ expr
       in
-      let kind = Some "class-type" in
+      let attr = [ "class-type" ] in
       let anchor = path_to_id t.id in
       let doc = Comment.first_to_ir t.doc in
-      Item.Declaration { kind; anchor; doc; content }
+      Item.Declaration { attr; anchor; doc; content }
   end
 
   open Class
@@ -1166,10 +1166,10 @@ module Make (Syntax : SYNTAX) = struct
         O.documentedSrc
           (O.keyword "module" ++ O.txt " " ++ O.txt name ++ O.txt " := " ++ path)
       in
-      let kind = Some "module-substitution" in
+      let attr = [ "module-substitution" ] in
       let anchor = path_to_id t.id in
       let doc = Comment.to_ir t.doc in
-      Item.Declaration { kind; anchor; doc; content }
+      Item.Declaration { attr; anchor; doc; content }
 
     and simple_expansion :
         Odoc_model.Lang.ModuleType.simple_expansion ->
@@ -1194,13 +1194,13 @@ module Make (Syntax : SYNTAX) = struct
           let params =
             Utils.flatmap params ~f:(fun arg ->
                 let content = functor_parameter arg in
-                let kind = Some "parameter" in
+                let attr = [ "parameter" ] in
                 let anchor =
                   Utils.option_of_result
                   @@ Url.Anchor.from_identifier (arg.id :> Paths.Identifier.t)
                 in
                 let doc = [] in
-                [ Item.Declaration { content; anchor; kind; doc } ])
+                [ Item.Declaration { content; anchor; attr; doc } ])
           in
           let prelude =
             Item.Heading
@@ -1283,10 +1283,10 @@ module Make (Syntax : SYNTAX) = struct
         @ O.documentedSrc
             (if Syntax.Mod.close_tag_semicolon then O.txt ";" else O.noop)
       in
-      let kind = Some "module" in
+      let attr = [ "module" ] in
       let anchor = path_to_id t.id in
       let doc = Comment.first_to_ir t.doc in
-      Item.Declaration { kind; anchor; doc; content }
+      Item.Declaration { attr; anchor; doc; content }
 
     and simple_expansion_in_decl (base : Paths.Identifier.Module.t) se =
       let rec ty_of_se :
@@ -1344,10 +1344,10 @@ module Make (Syntax : SYNTAX) = struct
         @ O.documentedSrc
             (if Syntax.Mod.close_tag_semicolon then O.txt ";" else O.noop)
       in
-      let kind = Some "module-type" in
+      let attr = [ "module-type" ] in
       let anchor = path_to_id t.id in
       let doc = Comment.first_to_ir t.doc in
-      Item.Declaration { kind; anchor; doc; content }
+      Item.Declaration { attr; anchor; doc; content }
 
     and umty_hidden : Odoc_model.Lang.ModuleType.U.expr -> bool = function
       | Path p -> Paths.Path.(is_hidden (p :> t))
@@ -1528,10 +1528,10 @@ module Make (Syntax : SYNTAX) = struct
           ++ if Syntax.Mod.include_semicolon then O.keyword ";" else O.noop )
       in
       let content = { Include.content; status; summary } in
-      let kind = Some "include" in
+      let attr = [ "include" ] in
       let anchor = None in
       let doc = Comment.first_to_ir sg_doc in
-      Item.Include { kind; anchor; doc; content }
+      Item.Include { attr; anchor; doc; content }
   end
 
   open Module
@@ -1556,9 +1556,9 @@ module Make (Syntax : SYNTAX) = struct
           Utils.option_of_result
           @@ Url.Anchor.from_identifier (id :> Paths.Identifier.t)
         in
-        let kind = Some "modules" in
+        let attr = [ "modules" ] in
         let doc = [] in
-        let decl = { Item.anchor; content; kind; doc } in
+        let decl = { Item.anchor; content; attr; doc } in
         Item.Declaration decl
       in
       List.map f t

src/document/types.ml

@@ -128,7 +128,7 @@ end =
 
 and Item : sig
   type 'a item = {
-    kind : string option;
+    attr : Class.t;
     anchor : Url.Anchor.t option;
     content : 'a;
     doc : Block.t;

src/html/generator.ml

@@ -204,8 +204,7 @@ let div : ([< Html_types.div_attrib ], [< item ], [> Html_types.div ]) Html.star
     =
   Html.Unsafe.node "div"
 
-let class_of_kind kind =
-  match kind with Some spec -> class_ [ "spec"; spec ] | None -> []
+let spec_class = function [] -> [] | attr -> class_ ("spec" :: attr)
 
 let spec_doc_div ~resolve = function
   | [] -> []
@@ -280,7 +279,7 @@ and items ~resolve l : item Html.elt list =
         content |> (continue_with [@tailcall]) rest
     | Heading h :: rest ->
         [ heading ~resolve h ] |> (continue_with [@tailcall]) rest
-    | Include { kind; anchor; doc; content = { summary; status; content } }
+    | 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
@@ -289,7 +288,7 @@ and items ~resolve l : item Html.elt list =
             let open' = if open' then [ Html.a_open () ] else [] in
             let summary =
               let anchor_attrib, anchor_link = mk_anchor anchor in
-              let a = class_of_kind kind @ anchor_attrib in
+              let a = spec_class attr @ anchor_attrib in
               Html.summary ~a @@ anchor_link @ source (inline ~resolve) summary
             in
             [ Html.details ~a:open' summary included_html ]
@@ -304,9 +303,9 @@ and items ~resolve l : item Html.elt list =
           [ Html.div ~a:[ Html.a_class [ "odoc-include" ] ] (doc @ content) ]
         in
         (continue_with [@tailcall]) rest inc
-    | Declaration { Item.kind; anchor; content; doc } :: rest ->
+    | Declaration { Item.attr; anchor; content; doc } :: rest ->
         let anchor_attrib, anchor_link = mk_anchor anchor in
-        let a = class_of_kind kind @ anchor_attrib in
+        let a = spec_class attr @ anchor_attrib in
         let content = anchor_link @ documentedSrc ~resolve content in
         let spec =
           let doc = spec_doc_div ~resolve doc in

src/latex/generator.ml

@@ -397,14 +397,14 @@ and items l =
         elts |> continue_with rest
     | Heading h :: rest -> heading h |> continue_with rest
     | Include
-        { kind = _; anchor; doc; content = { summary; status = _; content } }
+        { attr = _; anchor; doc; content = { summary; status = _; content } }
       :: rest ->
         let included = items content in
         let docs = block ~in_source:true doc in
         let summary = source (inline ~verbatim:false ~in_source:true) summary in
         let content = included in
         label anchor @ docs @ summary @ content |> continue_with rest
-    | Declaration { Item.kind = _; anchor; content; doc } :: rest ->
+    | Declaration { Item.attr = _; anchor; content; doc } :: rest ->
         let content = label anchor @ documentedSrc content in
         let elts =
           match doc with

src/manpage/generator.ml

@@ -450,7 +450,7 @@ and item ~nested (l : Item.t list) =
       | Heading h ->
           let h = heading ~nested h in
           vspace ++ h ++ vspace ++ item ~nested rest
-      | Declaration { kind = _; anchor = _; content; doc } ->
+      | Declaration { attr = _; anchor = _; content; doc } ->
           let decl = documentedSrc content in
           let doc =
             match doc with
@@ -459,7 +459,7 @@ and item ~nested (l : Item.t list) =
           in
           decl ++ doc ++ continue rest
       | Include
-          { kind = _; anchor = _; content = { summary; status; content }; doc }
+          { attr = _; anchor = _; content = { summary; status; content }; doc }
         ->
           let d =
             if inline_subpage status then item ~nested content