Add a frontmatter to mld pages

CHANGES.md

@@ -27,6 +27,7 @@
 - Added a `compile-asset` command (@EmileTrotignon, @panglesd, #1170)
 - Allow referencing assets (@panglesd, #1171)
 - Added a `--asset-path` arg to `html-generate` (@panglesd, #1185)
+- Add a frontmatter syntax for mld pages (@panglesd, #1187)
 
 ### Changed
 

src/model/comment.ml

@@ -1,3 +1,5 @@
+open Odoc_utils
+
 module Path = Paths.Path
 module Reference = Paths.Reference
 module Identifier = Paths.Identifier
@@ -130,15 +132,29 @@ and link_content_of_inline_elements l =
   l |> List.map link_content_of_inline_element |> List.concat
 
 let find_zero_heading docs : link_content option =
-  let rec find_map f = function
-    | [] -> None
-    | x :: l -> (
-        match f x with Some _ as result -> result | None -> find_map f l)
-  in
-  find_map
+  List.find_map
     (fun doc ->
       match doc.Location_.value with
       | `Heading ({ heading_level = `Title; _ }, _, h_content) ->
           Some (link_content_of_inline_elements h_content)
       | _ -> None)
     docs
+
+let extract_frontmatter docs : _ =
+  let parse_frontmatter s =
+    let lines = Astring.String.cuts ~sep:"\n" s in
+    List.filter_map (fun line -> Astring.String.cut ~sep:":" line) lines
+  in
+  let fm, content =
+    let fm, rev_content =
+      List.fold_left
+        (fun (fm_acc, content_acc) doc ->
+          match doc.Location_.value with
+          | `Code_block (Some "meta", content, None) ->
+              (parse_frontmatter content.Location_.value :: fm_acc, content_acc)
+          | _ -> (fm_acc, doc :: content_acc))
+        ([], []) docs
+    in
+    (List.concat fm, List.rev rev_content)
+  in
+  (fm, content)

src/model/dune

@@ -16,4 +16,4 @@
   (backend landmarks --auto))
  (instrumentation
   (backend bisect_ppx))
- (libraries result compiler-libs.common odoc-parser))
+ (libraries result compiler-libs.common odoc-parser odoc_utils))

src/model/frontmatter.ml

@@ -0,0 +1 @@
+type t = (string * string) list

src/model/lang.ml

@@ -532,6 +532,7 @@ module rec Page : sig
     root : Root.t;
     content : Comment.docs;
     children : child list;
+    frontmatter : Frontmatter.t;
     digest : Digest.t;
     linked : bool;
   }

src/model/root.ml

@@ -29,7 +29,11 @@ end
 module Odoc_file = struct
   type compilation_unit = { name : string; hidden : bool }
 
-  type page = { name : string; title : Comment.link_content option }
+  type page = {
+    name : string;
+    title : Comment.link_content option;
+    frontmatter : Frontmatter.t;
+  }
 
   type t =
     | Page of page
@@ -41,7 +45,7 @@ module Odoc_file = struct
     let hidden = force_hidden || Names.contains_double_underscore name in
     Compilation_unit { name; hidden }
 
-  let create_page name title = Page { name; title }
+  let create_page name title frontmatter = Page { name; title; frontmatter }
 
   let create_impl name = Impl name
 

src/model/root.mli

@@ -28,7 +28,11 @@ end
 module Odoc_file : sig
   type compilation_unit = { name : string; hidden : bool }
 
-  type page = { name : string; title : Comment.link_content option }
+  type page = {
+    name : string;
+    title : Comment.link_content option;
+    frontmatter : Frontmatter.t;
+  }
 
   type t =
     | Page of page
@@ -38,7 +42,7 @@ module Odoc_file : sig
 
   val create_unit : force_hidden:bool -> string -> t
 
-  val create_page : string -> Comment.link_content option -> t
+  val create_page : string -> Comment.link_content option -> Frontmatter.t -> t
 
   val create_impl : string -> t
 

src/model_desc/lang_desc.ml

@@ -697,6 +697,7 @@ and page_t =
     [
       F ("name", (fun t -> t.name), identifier);
       F ("root", (fun t -> t.root), root);
+      F ("frontmatter", (fun t -> t.frontmatter), List (Pair (string, string)));
       F ("content", (fun t -> t.content), docs);
       F ("digest", (fun t -> t.digest), Digest.t);
     ]

src/odoc/compile.ml

@@ -238,12 +238,16 @@ let mld ~parent_id ~parents_children ~output ~children ~warnings_options input =
   >>= fun name ->
   let resolve content =
     let zero_heading = Comment.find_zero_heading content in
+    let frontmatter, content = Comment.extract_frontmatter content in
     let root =
-      let file = Root.Odoc_file.create_page root_name zero_heading in
+      let file =
+        Root.Odoc_file.create_page root_name zero_heading frontmatter
+      in
       { Root.id = (name :> Paths.Identifier.OdocId.t); file; digest }
     in
     let page =
-      Lang.Page.{ name; root; children; content; digest; linked = false }
+      Lang.Page.
+        { name; root; children; content; digest; linked = false; frontmatter }
     in
     Odoc_file.save_page output ~warnings:[] page;
     Ok ()

src/odoc/html_fragment.ml

@@ -9,15 +9,26 @@ let from_mld ~xref_base_uri ~resolver ~output ~warnings_options input =
   in
   let input_s = Fs.File.to_string input in
   let digest = Digest.file input_s in
-  let root =
-    let file = Odoc_model.Root.Odoc_file.create_page page_name None in
-    { Odoc_model.Root.id; file; digest }
-  in
   let to_html content =
     (* This is a mess. *)
+    let frontmatter, content = Odoc_model.Comment.extract_frontmatter content in
+    let root =
+      let file =
+        Odoc_model.Root.Odoc_file.create_page page_name None frontmatter
+      in
+      { Odoc_model.Root.id; file; digest }
+    in
     let page =
       Odoc_model.Lang.Page.
-        { name = id; root; content; children = []; digest; linked = false }
+        {
+          name = id;
+          root;
+          content;
+          children = [];
+          digest;
+          linked = false;
+          frontmatter;
+        }
     in
     let env = Resolver.build_env_for_page resolver page in
     Odoc_xref2.Link.resolve_page ~filename:input_s env page

test/pages/frontmatter.t/one_frontmatter.mld

@@ -0,0 +1,6 @@
+{0 One frontmatter}
+
+{@meta[
+bli1: bloblobloblo1
+bli2: bloblobloblo2
+]}

test/pages/frontmatter.t/run.t

@@ -0,0 +1,101 @@
+When there is no frontmatter, everything is normal
+
+  $ odoc compile zero_frontmatter.mld
+  $ odoc_print page-zero_frontmatter.odoc | jq '.frontmatter'
+  []
+
+When there is one frontmatter, it is extracted from the content:
+
+  $ odoc compile one_frontmatter.mld
+  $ odoc_print page-one_frontmatter.odoc | jq '.frontmatter'
+  [
+    [
+      "bli1",
+      " bloblobloblo1"
+    ],
+    [
+      "bli2",
+      " bloblobloblo2"
+    ]
+  ]
+  $ odoc_print page-one_frontmatter.odoc | jq '.content'
+  [
+    {
+      "`Heading": [
+        {
+          "heading_level": "`Title",
+          "heading_label_explicit": "false"
+        },
+        {
+          "`Label": [
+            {
+              "`LeafPage": [
+                "None",
+                "one_frontmatter"
+              ]
+            },
+            "one-frontmatter"
+          ]
+        },
+        [
+          {
+            "`Word": "One"
+          },
+          "`Space",
+          {
+            "`Word": "frontmatter"
+          }
+        ]
+      ]
+    }
+  ]
+
+When there is more than one frontmatter, they are all extracted from the content:
+
+  $ odoc compile two_frontmatters.mld
+  $ odoc_print page-two_frontmatters.odoc | jq '.frontmatter'
+  [
+    [
+      "bli3",
+      " bloblobloblo1"
+    ],
+    [
+      "bli1",
+      " bloblobloblo1"
+    ],
+    [
+      "bli2",
+      " bloblobloblo2"
+    ]
+  ]
+  $ odoc_print page-two_frontmatters.odoc | jq '.content'
+  [
+    {
+      "`Heading": [
+        {
+          "heading_level": "`Title",
+          "heading_label_explicit": "false"
+        },
+        {
+          "`Label": [
+            {
+              "`LeafPage": [
+                "None",
+                "two_frontmatters"
+              ]
+            },
+            "two-frontmatters"
+          ]
+        },
+        [
+          {
+            "`Word": "Two"
+          },
+          "`Space",
+          {
+            "`Word": "frontmatters"
+          }
+        ]
+      ]
+    }
+  ]

test/pages/frontmatter.t/two_frontmatters.mld

@@ -0,0 +1,10 @@
+{0 Two frontmatters}
+
+{@meta[
+bli1: bloblobloblo1
+bli2: bloblobloblo2
+]}
+
+{@meta[
+bli3: bloblobloblo1
+]}

test/pages/frontmatter.t/zero_frontmatter.mld

@@ -0,0 +1 @@
+{0 No frontmatter}