Remove sections_allowed as it was not used (apart from in a test)

Author: panglesd

src/loader/doc_attr.ml

@@ -114,7 +114,7 @@ let pad_loc loc =
   { loc.Location.loc_start with pos_cnum = loc.loc_start.pos_cnum + 3 }
 
 let ast_to_comment ~internal_tags parent ast_docs alerts =
-  Odoc_model.Semantics.ast_to_comment ~internal_tags ~sections_allowed:`All
+  Odoc_model.Semantics.ast_to_comment ~internal_tags
     ~tags_allowed:true ~parent_of_sections:parent ast_docs alerts
   |> Error.raise_warnings
 
@@ -150,7 +150,6 @@ let attached_no_tag parent attrs =
 let read_string ~tags_allowed internal_tags parent location str =
   Odoc_model.Semantics.parse_comment
     ~internal_tags
-    ~sections_allowed:`All
     ~tags_allowed
     ~containing_definition:parent
     ~location

src/markdown/odoc_md.ml

@@ -13,8 +13,7 @@ let parse id input_s =
     Doc_of_md.parse_comment ~location ~text:str ()
   in
   let (content, ()), semantics_warnings =
-    Semantics.ast_to_comment ~internal_tags:Expect_none ~sections_allowed:`All
-      ~tags_allowed:false
+    Semantics.ast_to_comment ~internal_tags:Expect_none ~tags_allowed:false
       ~parent_of_sections:(id :> Paths.Identifier.LabelParent.t)
       content []
     |> Error.unpack_warnings

src/model/semantics.ml

@@ -102,12 +102,6 @@ let default_raw_markup_target_not_supported : Location.span -> Error.t =
   Error.make ~suggestion:"try '{%html:...%}'."
     "'{%%...%%}' (raw markup) needs a target language."
 
-let headings_not_allowed : Location.span -> Error.t =
-  Error.make "Headings not allowed in this comment."
-
-let titles_not_allowed : Location.span -> Error.t =
-  Error.make "Title-level headings {0 ...} are only allowed in pages."
-
 let bad_heading_level : int -> Location.span -> Error.t =
   Error.make "'%d': bad heading level (0-5 allowed)."
 
@@ -159,7 +153,6 @@ type alerts =
   [ `Tag of [ `Alert of string * string option ] ] Location_.with_location list
 
 type status = {
-  sections_allowed : sections_allowed;
   tags_allowed : bool;
   parent_of_sections : Paths.Identifier.LabelParent.t;
 }
@@ -450,42 +443,27 @@ let section_heading :
     in
     (top_heading_level, element)
   in
-
-  match (status.sections_allowed, level) with
-  | `None, _any_level ->
-      Error.raise_warning (headings_not_allowed location);
-      let text = (text :> Comment.inline_element with_location list) in
-      let element =
-        Location.at location
-          (`Paragraph [ Location.at location (`Styled (`Bold, text)) ])
-      in
-      (top_heading_level, element)
-  | `No_titles, 0 ->
-      Error.raise_warning (titles_not_allowed location);
-      mk_heading `Title
-  | _, level ->
-      let level' =
-        match level with
-        | 0 -> `Title
-        | 1 -> `Section
-        | 2 -> `Subsection
-        | 3 -> `Subsubsection
-        | 4 -> `Paragraph
-        | 5 -> `Subparagraph
-        | _ ->
-            Error.raise_warning (bad_heading_level level location);
-            (* Implicitly promote to level-5. *)
-            `Subparagraph
-      in
-      (match top_heading_level with
-      | Some top_level
-        when status.sections_allowed = `All && level <= top_level && level <= 5
-        ->
-          Error.raise_warning
-            (heading_level_should_be_lower_than_top_level level top_level
-               location)
-      | _ -> ());
-      mk_heading level'
+  let level' =
+    match level with
+    | 0 -> `Title
+    | 1 -> `Section
+    | 2 -> `Subsection
+    | 3 -> `Subsubsection
+    | 4 -> `Paragraph
+    | 5 -> `Subparagraph
+    | _ ->
+        Error.raise_warning (bad_heading_level level location);
+        (* Implicitly promote to level-5. *)
+        `Subparagraph
+  in
+  let () =
+    match top_heading_level with
+    | Some top_level when level <= top_level && level <= 5 ->
+        Error.raise_warning
+          (heading_level_should_be_lower_than_top_level level top_level location)
+    | _ -> ()
+  in
+  mk_heading level'
 
 let validate_first_page_heading status ast_element =
   match status.parent_of_sections.iv with
@@ -508,7 +486,7 @@ let top_level_block_elements status ast_elements =
     | [] -> List.rev comment_elements_acc
     | ast_element :: ast_elements -> (
         (* The first [ast_element] in pages must be a title or section heading. *)
-        if status.sections_allowed = `All && top_heading_level = None then
+        if top_heading_level = None then
           validate_first_page_heading status ast_element;
 
         match ast_element with
@@ -597,23 +575,23 @@ let append_alerts_to_comment alerts
   in
   comment @ (alerts : alerts :> Comment.docs)
 
-let ast_to_comment ~internal_tags ~sections_allowed ~tags_allowed
-    ~parent_of_sections (ast : Ast.t) alerts =
+let ast_to_comment ~internal_tags ~tags_allowed ~parent_of_sections
+    (ast : Ast.t) alerts =
   Error.catch_warnings (fun () ->
-      let status = { sections_allowed; tags_allowed; parent_of_sections } in
+      let status = { tags_allowed; parent_of_sections } in
       let ast, tags = strip_internal_tags ast in
       let elts =
         top_level_block_elements status ast |> append_alerts_to_comment alerts
       in
       (elts, handle_internal_tags tags internal_tags))
 
-let parse_comment ~internal_tags ~sections_allowed ~tags_allowed
-    ~containing_definition ~location ~text =
+let parse_comment ~internal_tags ~tags_allowed ~containing_definition ~location
+    ~text =
   Error.catch_warnings (fun () ->
       let ast =
         Odoc_parser.parse_comment ~location ~text |> Error.raise_parser_warnings
       in
-      ast_to_comment ~internal_tags ~sections_allowed ~tags_allowed
+      ast_to_comment ~internal_tags ~tags_allowed
         ~parent_of_sections:containing_definition ast []
       |> Error.raise_warnings)
 

src/model/semantics.mli

@@ -13,7 +13,6 @@ type alerts =
 
 val ast_to_comment :
   internal_tags:'tags handle_internal_tags ->
-  sections_allowed:sections_allowed ->
   tags_allowed:bool ->
   parent_of_sections:Paths.Identifier.LabelParent.t ->
   Odoc_parser.Ast.t ->
@@ -22,7 +21,6 @@ val ast_to_comment :
 
 val parse_comment :
   internal_tags:'tags handle_internal_tags ->
-  sections_allowed:sections_allowed ->
   tags_allowed:bool ->
   containing_definition:Paths.Identifier.LabelParent.t ->
   location:Lexing.position ->