Compatibility with odoc.2.4.1

Author: gpetiot

dune-project

@@ -51,11 +51,9 @@
   "Voodoo is an odoc driver used to generate OCaml.org's package documentation. voodoo-do runs the compilation step.")
  (depends
   voodoo-lib
-  ; odoc.2.2.0 pinned by the pipeline
+  ; odoc.2.4.1 pinned by the pipeline
   (odoc
-   (= 2.2.2))
-  (odoc-parser
-   (= 2.0.0))
+   (>= 2.4.1))
   bos
   astring
   cmdliner
@@ -71,11 +69,9 @@
   (omd
    (= 2.0.0~alpha3))
   voodoo-lib
-  ; odoc.2.2.0 pinned by the pipeline
+  ; odoc.2.4.1 pinned by the pipeline
   (odoc
-   (= 2.2.2))
-  (odoc-parser
-   (= 2.0.0))
+   (>= 2.4.1))
   conf-pandoc
   astring
   cmdliner

src/voodoo-gen/generate_html_docs.ml

@@ -10,6 +10,8 @@ let document_of_odocl ~syntax input =
       Ok (Renderer.document_of_page ~syntax odoctree)
   | Unit_content odoctree ->
       Ok (Renderer.document_of_compilation_unit ~syntax odoctree)
+  | Source_tree_content _ ->
+      Error (`Msg "document_of_odocl: Source_tree_content unexpected")
 
 let render_document ~output odoctree =
   let aux pages =
@@ -69,24 +71,26 @@ let render ~output file =
                 get_subpages subpage.content)
          |> List.flatten)
     in
-    get_subpages document
+    match document with
+    | Odoc_document.Types.Document.Page p -> get_subpages p
+    | _ -> []
   in
   Ok urls
 
 let render_text ~id ~output doc =
   let url = Odoc_document.Url.Path.from_identifier id in
-  Markdown.read_plain doc url >>= render_document ~output
+  Markdown.read_plain doc url >>= fun p -> render_document ~output (Page p)
 
 let render_markdown ~id ~output doc =
   let url = Odoc_document.Url.Path.from_identifier id in
   match Markdown.read_md doc url with
-  | Ok page -> render_document ~output page
+  | Ok page -> render_document ~output (Page page)
   | Error _ -> render_text ~id ~output doc
 
 let render_org ~id ~output doc =
   let url = Odoc_document.Url.Path.from_identifier id in
   match Markdown.read_org doc url with
-  | Ok page -> render_document ~output page
+  | Ok page -> render_document ~output (Page page)
   | Error _ -> render_text ~id ~output doc
 
 let render_other ~output ~parent ~otherdocs =

src/voodoo-gen/markdown.ml

@@ -42,7 +42,9 @@ let rec block : 'attr block -> intermediate = function
   | Blockquote (_, _bs) -> Bl []
   | Thematic_break _ -> Bl []
   | Heading (_, n, i) ->
-      It (Heading { label = None; level = n; title = inline i })
+      It
+        (Heading
+           { label = None; level = n; title = inline i; source_anchor = None })
   | Code_block (_, _a, b) ->
       Bl
         [
@@ -69,26 +71,28 @@ let of_content content ~name ~url =
   let md = Omd.of_string content in
   let intermediate = blocks md in
   let items = List.map (function It x -> x | Bl x -> Text x) intermediate in
+  let open Odoc_document.Types.Page in
   Ok
     (match items with
-    | [] -> Odoc_document.Types.Page.{ preamble = []; items = []; url }
+    | [] -> { preamble = []; items = []; url; source_anchor = None }
     | (Heading _ as x) :: rest ->
-        Odoc_document.Types.Page.{ preamble = [ x ]; items = rest; url }
+        { preamble = [ x ]; items = rest; url; source_anchor = None }
     | _ ->
-        Odoc_document.Types.Page.
-          {
-            preamble =
-              [
-                Heading
-                  {
-                    label = None;
-                    level = 1;
-                    title = [ { desc = Text name; attr = [] } ];
-                  };
-              ];
-            items;
-            url;
-          })
+        {
+          preamble =
+            [
+              Heading
+                {
+                  label = None;
+                  level = 1;
+                  title = [ { desc = Text name; attr = [] } ];
+                  source_anchor = None;
+                };
+            ];
+          items;
+          url;
+          source_anchor = None;
+        })
 
 let read_org f url =
   let name = Fpath.basename f in
@@ -108,18 +112,20 @@ let read_md f url =
 let read_plain f url =
   let name = Fpath.basename f in
   Bos.OS.File.read f >>= fun content ->
+  let open Odoc_document.Types.Page in
   Ok
-    Odoc_document.Types.Page.
-      {
-        url;
-        items = [ Text [ { desc = Verbatim content; attr = [] } ] ];
-        preamble =
-          [
-            Heading
-              {
-                label = None;
-                level = 1;
-                title = [ { desc = Text name; attr = [] } ];
-              };
-          ];
-      }
+    {
+      url;
+      items = [ Text [ { desc = Verbatim content; attr = [] } ] ];
+      preamble =
+        [
+          Heading
+            {
+              label = None;
+              level = 1;
+              title = [ { desc = Text name; attr = [] } ];
+              source_anchor = None;
+            };
+        ];
+      source_anchor = None;
+    }

src/voodoo-gen/search_index.ml

@@ -9,50 +9,65 @@ type entry = {
 module Generate = struct
   (** Get plain text doc-comment from a doc comment *)
 
+  module C = Odoc_model.Comment
+
   let get_value x = x.Odoc_model.Location_.value
 
-  let rec string_of_doc (doc : Odoc_model.Comment.docs) =
+  let rec string_of_doc (doc : C.docs) =
     doc |> List.map get_value
     |> List.map s_of_block_element
     |> String.concat " "
 
-  and s_of_block_element (be : Odoc_model.Comment.block_element) =
+  and s_of_block_element (be : C.block_element) =
     match be with
     | `Paragraph is -> inlines is
     | `Tag _ -> ""
     | `List (_, ls) ->
         List.map (fun x -> x |> List.map get_value |> List.map nestable) ls
         |> List.concat |> String.concat " "
-    | `Heading (_, _, h) -> link_content h
+    | `Heading (_, _, h) -> inlines h
     | `Modules _ -> ""
-    | `Code_block (_, s) -> s |> get_value
+    | `Code_block (_, s, _) -> s |> get_value
     | `Verbatim v -> v
     | `Math_block m -> m
+    | `Table { data; _ } -> grid data
+
+  and cell (c : _ C.cell) =
+    c |> fst |> List.map (fun x -> get_value x |> nestable) |> String.concat " "
 
-  and nestable (n : Odoc_model.Comment.nestable_block_element) =
-    s_of_block_element (n :> Odoc_model.Comment.block_element)
+  and row (r : _ C.row) = r |> List.map cell |> String.concat " "
+  and grid (g : _ C.grid) = g |> List.map row |> String.concat " "
 
-  and inlines is =
-    is |> List.map get_value |> List.map inline |> String.concat ""
+  and nestable (n : C.nestable_block_element) =
+    s_of_block_element (n :> C.block_element)
 
-  and inline (i : Odoc_model.Comment.inline_element) =
+  and inlines (is : C.inline_element C.with_location list) =
+    is |> List.map (fun x -> get_value x |> inline) |> String.concat ""
+
+  and leaf_inline (i : C.leaf_inline_element) =
     match i with
-    | `Code_span s -> s
+    | `Space -> " "
     | `Word w -> w
+    | `Code_span s -> s
     | `Math_span m -> m
-    | `Space -> " "
+    | `Raw_markup (_, _) -> ""
+
+  and inline (i : C.inline_element) =
+    match i with
+    | #C.leaf_inline_element as i -> leaf_inline (i :> C.leaf_inline_element)
+    | `Styled (_, b) -> inlines b
     | `Reference (_, c) -> link_content c
     | `Link (_, c) -> link_content c
-    | `Styled (_, b) -> inlines b
-    | `Raw_markup (_, _) -> ""
 
-  and link_content l =
-    l |> List.map get_value
-    |> List.map non_link_inline_element
-    |> String.concat ""
+  and link_content (l : C.link_content) = non_link_inlines l
+
+  and non_link_inline (x : C.non_link_inline_element) =
+    match x with
+    | #C.leaf_inline_element as x -> leaf_inline (x :> C.leaf_inline_element)
+    | `Styled (_, b) -> non_link_inlines b
 
-  and non_link_inline_element (n : Odoc_model.Comment.non_link_inline_element) =
-    inline (n :> Odoc_model.Comment.inline_element)
+  and non_link_inlines (is : C.non_link_inline_element C.with_location list) =
+    is |> List.map (fun x -> get_value x |> non_link_inline) |> String.concat ""
 
   let rec full_name_aux : Odoc_model.Paths.Identifier.t -> string list =
     let open Odoc_model.Names in
@@ -80,6 +95,8 @@ module Generate = struct
           FieldName.to_string name :: full_name_aux (parent :> Identifier.t)
       | `Extension (parent, name) ->
           ExtensionName.to_string name :: full_name_aux (parent :> Identifier.t)
+      | `ExtensionDecl (parent, _, name) ->
+          ExtensionName.to_string name :: full_name_aux (parent :> Identifier.t)
       | `Exception (parent, name) ->
           ExceptionName.to_string name :: full_name_aux (parent :> Identifier.t)
       | `CoreException name -> [ ExceptionName.to_string name ]
@@ -96,6 +113,17 @@ module Generate = struct
           :: full_name_aux (parent :> Identifier.t)
       | `Label (parent, name) ->
           LabelName.to_string name :: full_name_aux (parent :> Identifier.t)
+      | `SourceDir (parent, name) ->
+          name :: full_name_aux (parent :> Identifier.t)
+      | `AssetFile (parent, name) ->
+          name :: full_name_aux (parent :> Identifier.t)
+      | `SourceLocationMod parent -> full_name_aux (parent :> Identifier.t)
+      | `SourceLocation (parent, name) ->
+          DefName.to_string name :: full_name_aux (parent :> Identifier.t)
+      | `SourceLocationInternal (parent, name) ->
+          LocalName.to_string name :: full_name_aux (parent :> Identifier.t)
+      | `SourcePage (parent, name) ->
+          name :: full_name_aux (parent :> Identifier.t)
 
   let prefixname :
       [< Odoc_model.Paths.Identifier.t_pv ] Odoc_model.Paths.Identifier.id ->
@@ -134,7 +162,14 @@ module Generate = struct
       | `CoreException _ -> "core exception"
       | `Constructor _ -> "constructor"
       | `Extension _ -> "extension"
+      | `ExtensionDecl _ -> "extension-decl"
       | `Root _ -> "root"
+      | `SourceDir _ -> "source dir"
+      | `AssetFile _ -> "asset file"
+      | `SourceLocationMod _ -> "source location mod"
+      | `SourceLocation _ -> "source location"
+      | `SourceLocationInternal _ -> "source location internal"
+      | `SourcePage _ -> "source page"
     in
     let url = Odoc_html.Link.href ~config ~resolve:(Base "") url in
     let json =
@@ -172,6 +207,7 @@ module Load_doc = struct
     | `Constructor (parent, _) -> is_internal (parent :> Identifier.t)
     | `Field (parent, _) -> is_internal (parent :> Identifier.t)
     | `Extension (parent, _) -> is_internal (parent :> Identifier.t)
+    | `ExtensionDecl (parent, _, _) -> is_internal (parent :> Identifier.t)
     | `Exception (parent, _) -> is_internal (parent :> Identifier.t)
     | `CoreException _ -> false
     | `Value (_, name) -> ValueName.is_internal name
@@ -180,6 +216,13 @@ module Load_doc = struct
     | `Method (parent, _) -> is_internal (parent :> Identifier.t)
     | `InstanceVariable (parent, _) -> is_internal (parent :> Identifier.t)
     | `Label (parent, _) -> is_internal (parent :> Identifier.t)
+    | `SourceDir (parent, _) -> is_internal (parent :> Identifier.t)
+    | `AssetFile (parent, _) -> is_internal (parent :> Identifier.t)
+    | `SourceLocationMod parent -> is_internal (parent :> Identifier.t)
+    | `SourceLocation (parent, _) -> is_internal (parent :> Identifier.t)
+    | `SourceLocationInternal (parent, _) ->
+        is_internal (parent :> Identifier.t)
+    | `SourcePage (parent, _) -> is_internal (parent :> Identifier.t)
 
   let add t ppf =
     if is_internal t.id then ()

src/voodoo/mld.ml

@@ -11,6 +11,7 @@ let rec pp fmt v =
   let child_pp fmt = function
     | Odoc.CModule m -> Format.fprintf fmt "CModule %s" m
     | CPage p -> Format.fprintf fmt "CPage %s" p
+    | CSrc p -> Format.fprintf fmt "CSrc %s" p
   in
   Format.fprintf fmt "{ path: %a; name: %s; parent: %a; children: %a }" Fpath.pp
     v.path v.name (Fmt.option pp) v.parent

src/voodoo/odoc.ml

@@ -50,7 +50,7 @@ let compile_deps file =
       Format.eprintf "Failed to find digest for self (%s)\n%!" name;
       None
 
-type child = CModule of string | CPage of string
+type child = CModule of string | CPage of string | CSrc of string
 
 let compile ?parent ?output path ~includes ~children =
   let cmd = Bos.Cmd.(v "odoc" % "compile" % Fpath.to_string path) in
@@ -61,7 +61,7 @@ let compile ?parent ?output path ~includes ~children =
   in
   let cmd =
     match parent with
-    | Some str -> Bos.Cmd.(cmd % "--parent" % Printf.sprintf "\"%s\"" str)
+    | Some str -> Bos.Cmd.(cmd % "--parent" % Printf.sprintf "page-\"%s\"" str)
     | None -> cmd
   in
   let cmd =
@@ -76,6 +76,7 @@ let compile ?parent ?output path ~includes ~children =
           match c with
           | CModule m -> "module-" ^ m
           | CPage p -> "page-\"" ^ p ^ "\""
+          | CSrc p -> "src-" ^ p
         in
         Bos.Cmd.(cmd % "--child" % arg))
       cmd children

src/voodoo/odoc.mli

@@ -16,6 +16,7 @@ val compile_deps : Fpath.t -> (string * string * compile_dep list) option
 type child =
   | CModule of string  (** module name, e.g. 'String' *)
   | CPage of string  (** page name, e.g. 'packages' *)
+  | CSrc of string (* 'src' *)
 
 val compile :
   ?parent:string ->

src/voodoo/serialize/package_info.ml

@@ -3,6 +3,7 @@ module Kind = struct
     [ `Module
     | `Page
     | `LeafPage
+    | `SourcePage
     | `ModuleType
     | `Parameter of int
     | `Class
@@ -13,6 +14,7 @@ module Kind = struct
     | `Page -> "page"
     | `Module -> "module"
     | `LeafPage -> "leaf-page"
+    | `SourcePage -> "source"
     | `ModuleType -> "module-type"
     | `Parameter arg_num -> Printf.sprintf "argument-%d" arg_num
     | `Class -> "class"
@@ -23,6 +25,7 @@ module Kind = struct
     | "page" -> `Page
     | "module" -> `Module
     | "leaf-page" -> `LeafPage
+    | "source" -> `SourcePage
     | "module-type" -> `ModuleType
     | "class" -> `Class
     | "class-type" -> `ClassType

src/voodoo/serialize/package_info.mli

@@ -3,6 +3,7 @@ module Kind : sig
     [ `Module
     | `Page
     | `LeafPage
+    | `SourcePage
     | `ModuleType
     | `Parameter of int
     | `Class

test/can-render-org-files.t

@@ -37,6 +37,7 @@ Converted the README.org file in HTML
 Content of automatically generated Index.mld is fine
   $ cat output/p/$PKG/1.0/doc/index.html.json | jq .
   {
+    "type": "documentation",
     "uses_katex": false,
     "breadcrumbs": [
       {
@@ -61,6 +62,7 @@ Content of automatically generated Index.mld is fine
       }
     ],
     "toc": [],
+    "source_anchor": null,
     "preamble": "<h1 id=\"can-render-org-files-1.0\"><a href=\"#can-render-org-files-1.0\" class=\"anchor\"></a>can-render-org-files 1.0</h1>",
     "content": ""
   }