Skip to content

Commit

Permalink
Upgrade to odoc.2.4.1 (#128)
Browse files Browse the repository at this point in the history
  • Loading branch information
@gpetiot
gpetiot committed Mar 26, 2024
1 parent f7a7a09 commit dc54397
Show file tree
Hide file tree
Showing 15 changed files with 127 additions and 75 deletions.
12 changes: 4 additions & 8 deletions dune-project
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down
12 changes: 8 additions & 4 deletions src/voodoo-gen/generate_html_docs.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down Expand Up @@ -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 =
Expand Down
68 changes: 37 additions & 31 deletions src/voodoo-gen/markdown.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
[
Expand All @@ -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
Expand All @@ -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;
}
81 changes: 62 additions & 19 deletions src/voodoo-gen/search_index.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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 ]
Expand All @@ -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 ->
Expand Down Expand Up @@ -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 =
Expand Down Expand Up @@ -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
Expand All @@ -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 ()
Expand Down
1 change: 1 addition & 0 deletions src/voodoo/mld.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
5 changes: 3 additions & 2 deletions src/voodoo/odoc.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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 =
Expand All @@ -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
Expand Down
1 change: 1 addition & 0 deletions src/voodoo/odoc.mli
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 ->
Expand Down
3 changes: 3 additions & 0 deletions src/voodoo/serialize/package_info.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,7 @@ module Kind = struct
[ `Module
| `Page
| `LeafPage
| `SourcePage
| `ModuleType
| `Parameter of int
| `Class
Expand All @@ -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"
Expand All @@ -23,6 +25,7 @@ module Kind = struct
| "page" -> `Page
| "module" -> `Module
| "leaf-page" -> `LeafPage
| "source" -> `SourcePage
| "module-type" -> `ModuleType
| "class" -> `Class
| "class-type" -> `ClassType
Expand Down
1 change: 1 addition & 0 deletions src/voodoo/serialize/package_info.mli
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,7 @@ module Kind : sig
[ `Module
| `Page
| `LeafPage
| `SourcePage
| `ModuleType
| `Parameter of int
| `Class
Expand Down
2 changes: 2 additions & 0 deletions test/can-render-org-files.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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": [
{
Expand All @@ -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": ""
}
Expand Down
Loading

0 comments on commit dc54397

Please sign in to comment.