diff --git a/odoc.opam b/odoc.opam
index b6425ce4ae..42c0539492 100644
--- a/odoc.opam
+++ b/odoc.opam
@@ -51,7 +51,6 @@ depends: [
"tyxml" {>= "4.4.0"}
"fmt"
"crunch" {>= "1.4.1"}
-
"ocamlfind" {with-test}
"yojson" {>= "2.1.0" & with-test}
"sexplib0" {with-test}
diff --git a/src/markdown2/config.ml b/src/markdown2/config.ml
new file mode 100644
index 0000000000..af437d2fe3
--- /dev/null
+++ b/src/markdown2/config.ml
@@ -0,0 +1,5 @@
+(* Markdown output configuration *)
+
+type t = { root_url : string option; allow_html : bool }
+
+let make ~root_url ~allow_html () = { root_url; allow_html }
diff --git a/src/markdown2/dune b/src/markdown2/dune
new file mode 100644
index 0000000000..5c342ce37c
--- /dev/null
+++ b/src/markdown2/dune
@@ -0,0 +1,4 @@
+(library
+ (name odoc_markdown)
+ (public_name odoc.markdown)
+ (libraries odoc_model odoc_document))
diff --git a/src/markdown2/generator.ml b/src/markdown2/generator.ml
new file mode 100644
index 0000000000..d11e3c1ed1
--- /dev/null
+++ b/src/markdown2/generator.ml
@@ -0,0 +1,397 @@
+open Odoc_utils
+
+module Types = Odoc_document.Types
+module Doctree = Odoc_document.Doctree
+module Url = Odoc_document.Url
+
+let source fn (t : Types.Source.t) =
+ let rec token (x : Types.Source.token) =
+ match x with Elt i -> fn i | Tag (_, l) -> tokens l
+ and tokens t = List.concat_map token t in
+ tokens t
+
+and styled style content =
+ match style with
+ | `Bold ->
+ let inlines_as_one_inline = Renderer.Inline.Inlines content in
+ [ Renderer.Inline.Strong_emphasis inlines_as_one_inline ]
+ | `Italic | `Emphasis ->
+ (* We treat emphasis as italic, since there's no difference in Markdown *)
+ let inlines_as_one_inline = Renderer.Inline.Inlines content in
+ [ Renderer.Inline.Emphasis inlines_as_one_inline ]
+ | `Superscript | `Subscript ->
+ (* CommonMark doesn't have support for superscript/subscript, we fallback to inline *)
+ content
+
+let entity = function "#45" -> "-" | "gt" -> ">" | e -> "&" ^ e ^ ";"
+
+let rec inline_text_only inline =
+ List.concat_map
+ (fun (i : Types.Inline.one) ->
+ match i.desc with
+ | Text "" -> []
+ | Text s -> [ s ]
+ | Entity s -> [ entity s ]
+ | Linebreak -> []
+ | Styled (_, content) -> inline_text_only content
+ | Link { content; _ } -> inline_text_only content
+ | Source s -> source inline_text_only s
+ | _ -> [])
+ inline
+
+and block_text_only blocks : string list =
+ List.concat_map
+ (fun (b : Types.Block.one) ->
+ match b.desc with
+ | Paragraph inline | Inline inline -> inline_text_only inline
+ | Source (_, s) -> source inline_text_only s
+ | List (_, items) -> List.concat_map block_text_only items
+ | Verbatim s -> [ s ]
+ | _ -> [])
+ blocks
+
+and inline ~(config : Config.t) ~resolve l =
+ let one (t : Types.Inline.one) =
+ match t.desc with
+ | Text s -> [ Renderer.Inline.Text s ]
+ | Entity s ->
+ (* In CommonMark, HTML entities are supported directly, so we can just output them as text. Some markdown parsers may not support some entities. *)
+ [ Renderer.Inline.Text s ]
+ | Linebreak -> [ Renderer.Inline.Break ]
+ | Styled (style, c) ->
+ let inline_content = inline ~config ~resolve c in
+ styled style inline_content
+ | Link link -> inline_link ~config ~resolve link
+ | Source c ->
+ (* CommonMark doesn't allow any complex node inside inline text, rendering inline nodes as text *)
+ let content = source inline_text_only c in
+ [ Renderer.Inline.Code_span content ]
+ | Math s ->
+ (* Since CommonMark doesn't support Math's, we treat it a inline code *)
+ [ Renderer.Inline.Code_span [ s ] ]
+ | Raw_markup (target, content) -> (
+ match Astring.String.Ascii.lowercase target with
+ | "html" ->
+ let block_lines = content in
+ [ Renderer.Inline.Raw_html [ block_lines ] ]
+ | _ ->
+ (* Markdown only supports html blocks *)
+ [])
+ in
+ List.concat_map one l
+
+and inline_link ~config ~resolve link =
+ let href =
+ match link.target with
+ | External href -> Some href
+ | Internal internal -> (
+ match internal with
+ | Resolved uri -> Some (Link.href ~config ~resolve uri)
+ | Unresolved -> None)
+ in
+ match href with
+ | Some href ->
+ let inline_content = inline ~config ~resolve link.content in
+ let link_inline = Renderer.Inline.Inlines inline_content in
+ [ Renderer.Inline.Link { text = link_inline; url = Some href } ]
+ | None -> [ Renderer.Inline.Code_span (inline_text_only link.content) ]
+
+let rec block ~config ~resolve l =
+ let one (t : Types.Block.one) =
+ match t.desc with
+ | Paragraph paragraph ->
+ let inlines = inline ~config ~resolve paragraph in
+ let inlines = Renderer.Inline.Inlines inlines in
+ let paragraph_block = Renderer.Block.Paragraph inlines in
+ (* CommonMark treats paragraph as a block, to align the behavior with other generators such as HTML, we add a blank line after it *)
+ let break = Renderer.Block.Blank_line in
+ [ paragraph_block; break ]
+ | List (type_, l) ->
+ let items =
+ List.map
+ (fun items ->
+ let block = block ~config ~resolve items in
+ Renderer.Block.Blocks block)
+ l
+ in
+ [
+ (match type_ with
+ | Ordered -> Renderer.Block.Ordered_list items
+ | Unordered -> Renderer.Block.Unordered_list items);
+ ]
+ | Inline i ->
+ let inlines = Renderer.Inline.Inlines (inline ~config ~resolve i) in
+ [ Renderer.Block.Paragraph inlines ]
+ | Table t -> block_table ~config ~resolve t
+ | Description l ->
+ let item ({ key; definition; attr = _ } : Types.Description.one) =
+ let term = inline ~config ~resolve key in
+ (* We extract definition as inline *)
+ let definition_inline =
+ Renderer.Inline.Text
+ (String.concat ~sep:"" (block_text_only definition))
+ in
+ let space = Renderer.Inline.Text " " in
+ let term_inline =
+ Renderer.Inline.Inlines (term @ [ space; definition_inline ])
+ in
+ [ Renderer.Block.Paragraph term_inline ]
+ in
+ List.concat_map item l
+ | Verbatim s ->
+ let code_snippet =
+ Renderer.Block.Code_block { info_string = None; code = [ s ] }
+ in
+ [ code_snippet ]
+ | Source (lang, s) ->
+ let code = s |> source inline_text_only |> List.map (fun s -> s) in
+ let code_snippet =
+ Renderer.Block.Code_block { info_string = Some lang; code }
+ in
+ [ code_snippet ]
+ | Math s ->
+ (* Since CommonMark doesn't support Math's, we just treat it as code. Maybe could use Ext_math_block or Ext_math_display *)
+ let block =
+ Renderer.Block.Code_block { info_string = None; code = [ s ] }
+ in
+ [ block ]
+ | Raw_markup (target, content) -> (
+ match Astring.String.Ascii.lowercase target with
+ | "html" ->
+ let html_block_lines = Renderer.block_line_of_string content in
+ [ Renderer.Block.Html_block html_block_lines ]
+ | _ -> (* Markdown only supports html blocks *) [])
+ | Image (target, alt) ->
+ let url =
+ match (target : Types.Target.t) with
+ | External url -> Some url
+ | Internal (Resolved uri) -> Some (Link.href ~config ~resolve uri)
+ | Internal Unresolved -> None
+ in
+ let image : Renderer.Inline.link =
+ { text = Renderer.Inline.Text alt; url }
+ in
+ [
+ Renderer.Block.Paragraph
+ (Renderer.Inline.Inlines [ Renderer.Inline.Image image ]);
+ ]
+ | Audio (_target, _alt) | Video (_target, _alt) ->
+ (* Audio and video aren't supported in markdown *)
+ []
+ in
+ List.concat_map one l
+
+and block_table ~config ~resolve t =
+ let alignment = function
+ | Types.Table.Left -> Some `Left
+ | Types.Table.Center -> Some `Center
+ | Types.Table.Right -> Some `Right
+ | Types.Table.Default -> None
+ in
+
+ let convert_cell content =
+ match content with
+ | [ { Types.Block.desc = Paragraph p; _ } ]
+ | [ { Types.Block.desc = Inline p; _ } ] ->
+ inline ~config ~resolve p
+ | blocks ->
+ let text = String.concat ~sep:" " (block_text_only blocks) in
+ [ Renderer.Inline.Text text ]
+ in
+
+ let convert_row (row : (Types.Block.t * [ `Data | `Header ]) list) =
+ let cells =
+ List.map
+ (fun (content, _) -> Renderer.Inline.Inlines (convert_cell content))
+ row
+ in
+ match row with (_, `Header) :: _ -> `Header cells | _ -> `Data cells
+ in
+
+ match t.data with
+ | [] -> [ Renderer.Block.Paragraph (Renderer.Inline.Inlines []) ]
+ | rows ->
+ let table_rows = List.map convert_row rows in
+ let separator = `Sep (List.map alignment t.align) in
+ let rec insert_separator acc = function
+ | [] -> List.rev acc
+ | (`Header _ as h) :: (`Data _ :: _ as rest) ->
+ List.rev (h :: acc) @ [ separator ] @ rest
+ | (`Header _ as h) :: rest -> insert_separator (h :: acc) rest
+ | rows -> List.rev acc @ [ separator ] @ rows
+ in
+
+ let final_rows = insert_separator [] table_rows in
+ let table = Renderer.Block.Table.make final_rows in
+ [ Renderer.Block.Table table ]
+
+and items ~config ~resolve l : Renderer.Block.t list =
+ let rec walk_items acc (t : Types.Item.t list) =
+ let continue_with rest elts =
+ (walk_items [@tailcall]) (List.rev_append elts acc) rest
+ in
+ match t with
+ | [] -> List.rev acc
+ | Text _ :: _ as t ->
+ let text, _, rest =
+ Doctree.Take.until t ~classify:(function
+ | Types.Item.Text text -> Accum text
+ | _ -> Stop_and_keep)
+ in
+ let content = block ~config ~resolve text in
+ (continue_with [@tailcall]) rest content
+ | Heading h :: rest ->
+ (* Markdown headings are rendered as a blank line before and after the heading, otherwise it treats it as an inline paragraph *)
+ let break = Renderer.Block.Blank_line in
+ let inlines = inline ~config ~resolve h.title in
+ let content = Renderer.Inline.Inlines inlines in
+ let block : Renderer.Block.heading =
+ { level = h.level + 1; inline = content; id = None }
+ in
+ let heading_block = Renderer.Block.Heading block in
+ (continue_with [@tailcall]) rest [ break; heading_block; break ]
+ | Include
+ {
+ attr = _attr;
+ anchor = _anchor;
+ source_anchor = _source_anchor;
+ doc;
+ content = { summary = _summary; status = _status; content };
+ }
+ :: rest ->
+ let doc_content = block ~config ~resolve doc in
+ let included_content = walk_items [] content in
+ let all_content = doc_content @ included_content in
+ (continue_with [@tailcall]) rest all_content
+ | Declaration
+ {
+ attr = _attr;
+ anchor = _anchor;
+ source_anchor = _source_anchor;
+ content;
+ doc;
+ }
+ :: rest ->
+ let spec = documentedSrc ~config ~resolve content in
+ let doc = block ~config ~resolve doc in
+ let content = spec @ doc in
+ (continue_with [@tailcall]) rest content
+ and items l = walk_items [] l in
+ items l
+
+and documentedSrc ~config ~resolve t =
+ let open Types.DocumentedSrc in
+ let take_code l =
+ Doctree.Take.until l ~classify:(fun x ->
+ match (x : one) with
+ | Code code -> Accum code
+ | Alternative (Expansion { summary; _ }) -> Accum summary
+ | _ -> Stop_and_keep)
+ in
+ let take_descr l =
+ Doctree.Take.until l ~classify:(function
+ | Documented { attrs; anchor; code; doc; markers } ->
+ Accum [ { attrs; anchor; code = `D code; doc; markers } ]
+ | Nested { attrs; anchor; code; doc; markers } ->
+ Accum [ { attrs; anchor; code = `N code; doc; markers } ]
+ | _ -> Stop_and_keep)
+ in
+ let rec to_markdown t : Renderer.Block.t list =
+ match t with
+ | [] -> []
+ | (Code _ | Alternative _) :: _ ->
+ let code, header, rest = take_code t in
+ let info_string =
+ match header with Some header -> Some header | None -> None
+ in
+ let inline_source = source inline_text_only code in
+ let code = [ String.concat ~sep:"" inline_source ] in
+ let block = Renderer.Block.Code_block { info_string; code } in
+ [ block ] @ to_markdown rest
+ | Subpage subp :: _ -> subpage ~config ~resolve subp
+ | (Documented _ | Nested _) :: _ ->
+ let l, _, rest = take_descr t in
+ let one { attrs = _; anchor = _; code; doc; markers = _ } =
+ let content =
+ match code with
+ | `D code ->
+ let inline_source = inline ~config ~resolve code in
+ let inlines = Renderer.Inline.Inlines inline_source in
+ let block = Renderer.Block.Paragraph inlines in
+ [ block ]
+ | `N n -> to_markdown n
+ in
+ let block_doc = block ~config ~resolve doc in
+ List.append content block_doc
+ in
+ let all_blocks = List.concat_map one l in
+ all_blocks @ to_markdown rest
+ in
+ to_markdown t
+
+and subpage ~config ~resolve (subp : Types.Subpage.t) =
+ items ~config ~resolve subp.content.items
+
+module Page = struct
+ let on_sub = function
+ | `Page _ -> None
+ | `Include (x : Types.Include.t) -> (
+ match x.status with
+ | `Closed | `Open | `Default -> None
+ | `Inline -> Some 0)
+
+ let rec include_ ~config { Types.Subpage.content; _ } = page ~config content
+
+ and subpages ~config subpages = List.map (include_ ~config) subpages
+
+ and page ~config p =
+ let subpages = subpages ~config @@ Doctree.Subpages.compute p in
+ let resolve = Link.Current p.url in
+ let i = Doctree.Shift.compute ~on_sub p.items in
+ let header, preamble =
+ Doctree.PageTitle.render_title ?source_anchor:p.source_anchor p
+ in
+ let header = items ~config ~resolve header in
+ let preamble = items ~config ~resolve preamble in
+ let content = items ~config ~resolve i in
+ let root_block = Renderer.Block.Blocks (header @ preamble @ content) in
+ let doc = root_block in
+ Markdown_page.make ~config ~url:p.url doc subpages
+
+ and source_page ~config sp =
+ let { Types.Source_page.url; contents; _ } = sp in
+ let resolve = Link.Current sp.url in
+ let title = url.Url.Path.name in
+ let header =
+ items ~config ~resolve (Doctree.PageTitle.render_src_title sp)
+ in
+ let extract_source_text docs =
+ let rec doc_to_text span =
+ match (span : Types.Source_page.span) with
+ | Plain_code s -> s
+ | Tagged_code (_, docs) ->
+ String.concat ~sep:"" (List.map doc_to_text docs)
+ in
+
+ docs |> List.map doc_to_text |> String.concat ~sep:"" |> String.trim
+ in
+ let source_block =
+ Renderer.Block.Code_block
+ { info_string = Some "ocaml"; code = [ extract_source_text contents ] }
+ in
+ let doc = header @ [ source_block ] in
+ Markdown_page.make_src ~config ~url title doc
+end
+
+let render ~(config : Config.t) doc =
+ match (doc : Types.Document.t) with
+ (* .mld *)
+ | Page page -> [ Page.page ~config page ]
+ (* .mli docs *)
+ | Source_page src -> [ Page.source_page ~config src ]
+
+let inline ~config ~xref_base_uri b =
+ let resolve = Link.Base xref_base_uri in
+ inline ~config ~resolve b
+
+let filepath ~config url = Link.Path.as_filename ~config url
diff --git a/src/markdown2/generator.mli b/src/markdown2/generator.mli
new file mode 100644
index 0000000000..fd26d1013d
--- /dev/null
+++ b/src/markdown2/generator.mli
@@ -0,0 +1,18 @@
+val render :
+ config:Config.t ->
+ Odoc_document.Types.Document.t ->
+ Odoc_document.Renderer.page list
+
+val filepath : config:Config.t -> Odoc_document.Url.Path.t -> Fpath.t
+
+val items :
+ config:Config.t ->
+ resolve:Link.resolve ->
+ Odoc_document.Types.Item.t list ->
+ Renderer.Block.t list
+
+val inline :
+ config:Config.t ->
+ xref_base_uri:string ->
+ Odoc_document.Types.Inline.t ->
+ Renderer.Inline.t list
diff --git a/src/markdown2/link.ml b/src/markdown2/link.ml
new file mode 100644
index 0000000000..2c4d700289
--- /dev/null
+++ b/src/markdown2/link.ml
@@ -0,0 +1,115 @@
+module Url = Odoc_document.Url
+
+type link = Relative of string list * string | Absolute of string
+
+(* Translation from Url.Path *)
+module Path = struct
+ let for_printing url = List.map snd @@ Url.Path.to_list url
+
+ let segment_to_string (kind, name) =
+ Format.asprintf "%a%s" Url.Path.pp_disambiguating_prefix kind name
+
+ let is_leaf_page url = url.Url.Path.kind = `LeafPage
+
+ let remap _config f =
+ let l = String.concat "/" f in
+ let remaps =
+ []
+ (* List.filter
+ (fun (prefix, _replacement) -> Astring.String.is_prefix ~affix:prefix l)
+ false (* (Config.remap config) *) *)
+ in
+ let remaps =
+ List.sort
+ (fun (a, _) (b, _) -> compare (String.length b) (String.length a))
+ remaps
+ in
+ match remaps with
+ | [] -> None
+ | (prefix, replacement) :: _ ->
+ let len = String.length prefix in
+ let l = String.sub l len (String.length l - len) in
+ Some (replacement ^ l)
+
+ let get_dir_and_file ~config:_ url =
+ let l = Url.Path.to_list url in
+ let is_dir =
+ if (* Config.flat config *) true then function
+ | `Page -> `Always | _ -> `Never
+ else function `LeafPage | `File | `SourcePage -> `Never | _ -> `Always
+ in
+ let dir, file = Url.Path.split ~is_dir l in
+ let dir = List.map segment_to_string dir in
+ let file =
+ match file with
+ | [] -> "index.md"
+ | [ (`LeafPage, name) ] -> name ^ ".md"
+ | [ (`File, name) ] -> name
+ | [ (`SourcePage, name) ] -> name ^ ".md"
+ | xs ->
+ (* assert (Config.flat config); *)
+ String.concat "-" (List.map segment_to_string xs) ^ ".md"
+ in
+ (dir, file)
+
+ let for_linking ~config url =
+ let dir, file = get_dir_and_file ~config url in
+ match remap config dir with
+ | None -> Relative (dir, file)
+ | Some x -> Absolute (x ^ "/" ^ file)
+
+ let as_filename ~config (url : Url.Path.t) =
+ let dir, file = get_dir_and_file ~config url in
+ Fpath.(v @@ String.concat Fpath.dir_sep (dir @ [ file ]))
+end
+
+type resolve = Current of Url.Path.t | Base of string
+
+let rec drop_shared_prefix l1 l2 =
+ match (l1, l2) with
+ | l1 :: l1s, l2 :: l2s when l1 = l2 -> drop_shared_prefix l1s l2s
+ | _, _ -> (l1, l2)
+
+let href ~config ~resolve t =
+ let { Url.Anchor.page; anchor; _ } = t in
+ let add_anchor y = match anchor with "" -> y | anchor -> y ^ "#" ^ anchor in
+ let target_loc = Path.for_linking ~config page in
+
+ match target_loc with
+ | Absolute y -> add_anchor y
+ | Relative (dir, file) -> (
+ let target_loc = dir @ [ file ] in
+ (* If xref_base_uri is defined, do not perform relative URI resolution. *)
+ match resolve with
+ | Base xref_base_uri ->
+ let page = xref_base_uri ^ String.concat "/" target_loc in
+ add_anchor page
+ | Current path -> (
+ let current_loc =
+ let dir, file = Path.get_dir_and_file ~config path in
+ dir @ [ file ]
+ in
+ let current_from_common_ancestor, target_from_common_ancestor =
+ drop_shared_prefix current_loc target_loc
+ in
+
+ let relative_target =
+ match current_from_common_ancestor with
+ | [] ->
+ (* We're already on the right page *)
+ (* If we're already on the right page, the target from our common
+ ancestor can't be anything other than the empty list *)
+ assert (target_from_common_ancestor = []);
+ []
+ | [ _ ] ->
+ (* We're already in the right dir *)
+ target_from_common_ancestor
+ | l ->
+ (* We need to go up some dirs *)
+ List.map (fun _ -> "..") (List.tl l)
+ @ target_from_common_ancestor
+ in
+ match (relative_target, anchor) with
+ | [], "" -> "#"
+ (* TODO: This looks wrong ./ could technically be the current page *)
+ | page, _ -> "./" ^ add_anchor @@ String.concat "/" page))
diff --git a/src/markdown2/link.mli b/src/markdown2/link.mli
new file mode 100644
index 0000000000..0090330505
--- /dev/null
+++ b/src/markdown2/link.mli
@@ -0,0 +1,13 @@
+(** Markdown-specific interpretation of {!Odoc_document.Url} *)
+
+type resolve = Current of Odoc_document.Url.Path.t | Base of string
+
+val href : config:Config.t -> resolve:resolve -> Odoc_document.Url.t -> string
+
+module Path : sig
+ val is_leaf_page : Odoc_document.Url.Path.t -> bool
+
+ val for_printing : Odoc_document.Url.Path.t -> string list
+
+ val as_filename : config:Config.t -> Odoc_document.Url.Path.t -> Fpath.t
+end
diff --git a/src/markdown2/markdown_page.ml b/src/markdown2/markdown_page.ml
new file mode 100644
index 0000000000..26203b5a2e
--- /dev/null
+++ b/src/markdown2/markdown_page.ml
@@ -0,0 +1,15 @@
+module Url = Odoc_document.Url
+
+let make ~config ~url doc children =
+ let filename = Link.Path.as_filename ~config url in
+ let content ppf = Format.fprintf ppf "%s" (Renderer.to_string doc) in
+ { Odoc_document.Renderer.filename; content; children; path = url }
+
+let make_src ~config ~url _title block_list =
+ let filename = Link.Path.as_filename ~config url in
+ let content (ppf : Format.formatter) =
+ let root_block = Renderer.Block.Blocks block_list in
+ let doc = root_block in
+ Format.fprintf ppf "%s" (Renderer.to_string doc)
+ in
+ { Odoc_document.Renderer.filename; content; children = []; path = url }
diff --git a/src/markdown2/markdown_page.mli b/src/markdown2/markdown_page.mli
new file mode 100644
index 0000000000..4ce2741f98
--- /dev/null
+++ b/src/markdown2/markdown_page.mli
@@ -0,0 +1,17 @@
+(** Supported languages for printing code parts. *)
+
+(** {1 Page creator} *)
+
+val make :
+ config:Config.t ->
+ url:Odoc_document.Url.Path.t ->
+ Renderer.doc ->
+ Odoc_document.Renderer.page list ->
+ Odoc_document.Renderer.page
+
+val make_src :
+ config:Config.t ->
+ url:Odoc_document.Url.Path.t ->
+ string ->
+ Renderer.Block.t list ->
+ Odoc_document.Renderer.page
diff --git a/src/markdown2/renderer.ml b/src/markdown2/renderer.ml
new file mode 100644
index 0000000000..b471433be7
--- /dev/null
+++ b/src/markdown2/renderer.ml
@@ -0,0 +1,608 @@
+(* This module is based on cmarkit (https://github.com/dbuenzli/cmarkit) which is distributed under the ISC License. *)
+
+let is_control = function '\x00' .. '\x1F' | '\x7F' -> true | _ -> false
+
+let is_letter = function 'a' .. 'z' | 'A' .. 'Z' -> true | _ -> false
+
+let is_digit = function '0' .. '9' -> true | _ -> false
+
+let is_alphanum = function
+ | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' -> true
+ | _ -> false
+
+let block_line_of_string s =
+ let flush s start last acc =
+ let sub = String.sub s start (last - start + 1) in
+ sub :: acc
+ in
+ (* cuts [s] on newlines *)
+ let rec loop s acc max start k =
+ if k > max then List.rev (flush s start max acc)
+ else if not (s.[k] = '\n' || s.[k] = '\r') then loop s acc max start (k + 1)
+ else
+ let acc = flush s start (k - 1) acc in
+ let next = k + 1 in
+ let start =
+ if s.[k] = '\r' && next <= max && s.[next] = '\n' then next + 1
+ else next
+ in
+ loop s acc max start start
+ in
+ loop s [] (String.length s - 1) 0 0
+
+type label = { key : string; text : string list }
+
+module Inline = struct
+ type t =
+ | Break
+ | Inlines of t list
+ | Text of string (* plain text *)
+ | Code_span of string list (* `code` *)
+ | Emphasis of t (* *emphasis* *)
+ | Strong_emphasis of t (* **strong emphasis** *)
+ | Image of link (*  *)
+ | Link of link (* [link text](url) *)
+ | Raw_html of string list (* *)
+ and link = { text : t; url : string option }
+
+ let is_empty = function Text "" | Inlines [] -> true | _ -> false
+end
+
+module Block = struct
+ type code_block = { info_string : string option; code : string list }
+ type list_type = Unordered | Ordered
+
+ type id = [ `Auto of string | `Id of string ]
+ type heading = { level : int; inline : Inline.t; id : id option }
+
+ module Table = struct
+ type sep = [ `Left | `Center | `Right ] option
+ type row =
+ [ `Header of Inline.t list | `Sep of sep list | `Data of Inline.t list ]
+ type t = { col_count : int; rows : row list }
+
+ let col_count rows =
+ let rec loop c = function
+ | (`Header cols | `Data cols) :: rs ->
+ loop (Int.max (List.length cols) c) rs
+ | `Sep cols :: rs -> loop (Int.max (List.length cols) c) rs
+ | [] -> c
+ in
+ loop 0 rows
+
+ let make rows = { col_count = col_count rows; rows }
+
+ let rows t = t.rows
+
+ let parse_sep_row cs =
+ let rec loop acc = function
+ | [] -> Some (List.rev acc)
+ | (Inline.Text s, ("", "")) :: cs -> (
+ if s = "" then None
+ else
+ let max = String.length s - 1 in
+ let first_colon = s.[0] = ':' and last_colon = s.[max] = ':' in
+ let first = if first_colon then 1 else 0 in
+ let last = if last_colon then max - 1 else max in
+ match
+ for i = first to last do
+ if s.[i] <> '-' then raise Exit
+ done
+ with
+ | exception Exit -> None
+ | () ->
+ let count = last - first + 1 in
+ let sep =
+ match (first_colon, last_colon) with
+ | false, false -> None
+ | true, true -> Some `Center
+ | true, false -> Some `Left
+ | false, true -> Some `Right
+ in
+ loop ((sep, count) :: acc) cs)
+ | _ -> None
+ in
+ loop [] cs
+ end
+
+ type t =
+ | Blank_line
+ | Blocks of t list
+ | Code_block of code_block (* ``` xxx ``` *)
+ | Heading of heading (* # heading *)
+ | Html_block of string list (* raw html *)
+ | Unordered_list of t list (* - item *)
+ | Ordered_list of t list (* 1. item *)
+ | Paragraph of Inline.t (* paragraph *)
+ | Table of Table.t
+ let empty = Blocks []
+end
+
+type doc = Block.t
+
+module Heterogeneous_dict = struct
+ (* Type identifiers *)
+ module Type = struct
+ type (_, _) eq = Equal : ('a, 'a) eq
+ module Id = struct
+ type _ id = ..
+ module type ID = sig
+ type t
+ type _ id += Id : t id
+ end
+ type 'a t = (module ID with type t = 'a)
+
+ let make (type a) () : a t =
+ (module struct
+ type t = a
+ type _ id += Id : t id
+ end)
+
+ let provably_equal (type a b) ((module A) : a t) ((module B) : b t) :
+ (a, b) eq option =
+ match A.Id with B.Id -> Some Equal | _ -> None
+
+ let uid (type a) ((module A) : a t) =
+ Obj.Extension_constructor.id (Obj.Extension_constructor.of_val A.Id)
+ end
+ end
+
+ module M = Map.Make (Int)
+ type 'a key = 'a Type.Id.t
+ type binding = B : 'a key * 'a -> binding
+ type t = binding M.t
+
+ let key = Type.Id.make
+ let empty = M.empty
+ let mem k m = M.mem (Type.Id.uid k) m
+ let add k v m = M.add (Type.Id.uid k) (B (k, v)) m
+ let tag k m = add k () m
+ let remove k m = M.remove (Type.Id.uid k) m
+ let find : type a. a key -> t -> a option =
+ fun k m ->
+ match M.find_opt (Type.Id.uid k) m with
+ | None -> None
+ | Some (B (k', v)) -> (
+ match Type.Id.provably_equal k k' with
+ | None -> assert false
+ | Some Type.Equal -> Some v)
+end
+
+type t = {
+ init_context : context -> doc -> unit;
+ inline : inline;
+ block : block;
+}
+
+and context = {
+ renderer : t;
+ mutable state : Heterogeneous_dict.t;
+ b : Buffer.t;
+}
+
+and inline = context -> Inline.t -> unit
+and block = context -> Block.t -> unit
+
+module Context = struct
+ type t = context
+ let make renderer b = { renderer; b; state = Heterogeneous_dict.empty }
+
+ let buffer c = c.b
+
+ module State = struct
+ type 'a t = 'a Heterogeneous_dict.key
+ let make = Heterogeneous_dict.key
+ let find c st = Heterogeneous_dict.find st c.state
+ let get c st = Option.get (Heterogeneous_dict.find st c.state)
+ let set c st = function
+ | None -> c.state <- Heterogeneous_dict.remove st c.state
+ | Some s -> c.state <- Heterogeneous_dict.add st s c.state
+ end
+
+ let init c d = c.renderer.init_context c d
+
+ let byte r c = Buffer.add_char r.b c
+ let utf_8_uchar r u = Buffer.add_utf_8_uchar r.b u
+ let string c s = Buffer.add_string c.b s
+ let inline c i = c.renderer.inline c i
+ let block c b = c.renderer.block c b
+ let doc (c : context) d =
+ init c d;
+ c.renderer.block c d
+end
+
+type indent = [ `I of int | `L of int * string * int * Uchar.t option ]
+
+type state = {
+ newline_to_output : string;
+ mutable start_of_text : bool;
+ mutable identation_stack : indent list;
+}
+
+let state : state Context.State.t = Context.State.make ()
+let get_state c = Context.State.get c state
+let init_context c _d =
+ Context.State.set c state
+ (Some
+ { newline_to_output = "\n"; start_of_text = true; identation_stack = [] })
+
+module Char_set = Set.Make (Char)
+
+let esc_parens = Char_set.of_list [ '('; ')' ]
+let esc_quote = Char_set.singleton '\''
+let esc_dquote = Char_set.singleton '\"'
+let esc_link_label = Char_set.of_list [ '['; ']'; '\\' ]
+
+let buffer_add_dec_esc b c =
+ Buffer.add_string b "&#";
+ Buffer.add_string b (Int.to_string (Char.code c));
+ Buffer.add_char b ';'
+
+let buffer_add_bslash_esc b c =
+ Buffer.add_char b '\\';
+ Buffer.add_char b c
+
+let buffer_add_escaped_string ?(esc_ctrl = true) b cs s =
+ let flush b max start i =
+ if start <= max then Buffer.add_substring b s start (i - start)
+ in
+ let rec loop b s max start i =
+ if i > max then flush b max start i
+ else
+ let next = i + 1 in
+ let c = String.get s i in
+ if Char_set.mem c cs then (
+ flush b max start i;
+ buffer_add_bslash_esc b c;
+ loop b s max next next)
+ else if esc_ctrl && is_control c then (
+ flush b max start i;
+ buffer_add_dec_esc b c;
+ loop b s max next next)
+ else loop b s max start next
+ in
+ loop b s (String.length s - 1) 0 0
+
+let escaped_string ?esc_ctrl c cs s =
+ buffer_add_escaped_string ?esc_ctrl (Context.buffer c) cs s
+
+let buffer_add_escaped_text b s =
+ let esc_first b s =
+ match s.[0] with
+ | ('-' | '+' | '_' | '=') as c ->
+ Buffer.add_char b '\\';
+ Buffer.add_char b c;
+ true
+ | _ -> false
+ in
+ let esc_amp s max next =
+ next <= max && (is_letter s.[next] || s.[next] = '#')
+ in
+ let esc_tilde s max prev next =
+ (not (Char.equal prev '~')) && next <= max && s.[next] = '~'
+ in
+ let esc_item_marker s i =
+ if i = 0 || i > 9 (* marker has from 1-9 digits *) then false
+ else
+ let k = ref (i - 1) in
+ while !k >= 0 && is_digit s.[!k] do
+ decr k
+ done;
+ !k < 0
+ in
+ let flush b max start i =
+ if start <= max then Buffer.add_substring b s start (i - start)
+ in
+ let rec loop b s max start prev i =
+ if i > max then flush b max start i
+ else
+ let next = i + 1 in
+ let c = String.get s i in
+ if is_control c then (
+ flush b max start i;
+ buffer_add_dec_esc b c;
+ loop b s max next c next)
+ else
+ match c with
+ | ('#' | '`') when not (Char.equal prev c) ->
+ flush b max start i;
+ buffer_add_bslash_esc b c;
+ loop b s max next c next
+ | '~' when esc_tilde s max prev next ->
+ flush b max start i;
+ buffer_add_bslash_esc b c;
+ loop b s max next c next
+ | '&' when esc_amp s max next ->
+ flush b max start i;
+ buffer_add_bslash_esc b c;
+ loop b s max next c next
+ | '!' when i = max ->
+ flush b max start i;
+ buffer_add_bslash_esc b c;
+ loop b s max next c next
+ | ('.' | ')') when esc_item_marker s i ->
+ flush b max start i;
+ buffer_add_bslash_esc b c;
+ loop b s max next c next
+ | '\\' | '<' | '>' | '[' | ']' | '*' | '_' | '$' | '|' ->
+ flush b max start i;
+ buffer_add_bslash_esc b c;
+ loop b s max next c next
+ | _ -> loop b s max start c next
+ in
+ let max = String.length s - 1 in
+ if max < 0 then ()
+ else if esc_first b s then loop b s max 1 s.[0] 1
+ else loop b s max 0 '\x00' 0
+
+let escaped_text c s = buffer_add_escaped_text (Context.buffer c) s
+
+let nchars c n char =
+ for _i = 1 to n do
+ Context.byte c char
+ done
+
+let newline c =
+ (* Block generally introduce newlines, except the first one. *)
+ let state = get_state c in
+ if state.start_of_text then state.start_of_text <- false
+ else Context.string c state.newline_to_output
+
+let push_indent c n =
+ let state = get_state c in
+ state.identation_stack <- n :: state.identation_stack
+
+let pop_indent c =
+ let state = get_state c in
+ match state.identation_stack with
+ | [] -> ()
+ | ns -> state.identation_stack <- List.tl ns
+
+let rec indent c =
+ let rec loop c acc = function
+ | [] -> acc
+ | (`I n as i) :: is ->
+ nchars c n ' ';
+ loop c (i :: acc) is
+ | `L (before, m, after, task) :: is ->
+ nchars c before ' ';
+ Context.string c m;
+ nchars c after ' ';
+ let after =
+ match task with
+ | None -> after
+ | Some u ->
+ Context.byte c '[';
+ Context.utf_8_uchar c u;
+ Context.string c "] ";
+ after + 4
+ in
+ (* On the next call we'll just indent for the list item *)
+ loop c (`I (before + String.length m + after) :: acc) is
+ | _ -> []
+ in
+ let state = get_state c in
+ state.identation_stack <- loop c [] (List.rev state.identation_stack)
+
+and link_label_lines c lines = escaped_tight_block_lines c esc_link_label lines
+
+and escaped_tight_block_lines c cs = function
+ | [] -> ()
+ | l :: ls ->
+ let tight c blanks =
+ Context.string c blanks;
+ escaped_string c cs l
+ in
+ let line c l =
+ newline c;
+ indent c;
+ tight c l
+ in
+ tight c l;
+ List.iter (line c) ls
+
+let block_lines c = function
+ | [] -> ()
+ | l :: ls ->
+ let line c l =
+ newline c;
+ indent c;
+ Context.string c l
+ in
+ Context.string c l;
+ List.iter (line c) ls
+
+let break c =
+ Context.string c " ";
+ newline c;
+ indent c
+
+let code_span c cs =
+ nchars c 1 '`';
+ List.iter (Context.string c) cs;
+ nchars c 1 '`'
+
+let emphasis c i =
+ let delim = '*' in
+ Context.byte c delim;
+ Context.inline c i;
+ Context.byte c delim
+
+let strong_emphasis c i =
+ let delim = '*' in
+ Context.byte c delim;
+ Context.byte c delim;
+ Context.inline c i;
+ Context.byte c delim;
+ Context.byte c delim
+
+let link_title c open_delim title =
+ match title with
+ | None -> ()
+ | Some lines ->
+ let open', close, escapes =
+ match open_delim with
+ | '\"' as delim -> (delim, delim, esc_dquote)
+ | '\'' as delim -> (delim, delim, esc_quote)
+ | '(' -> ('(', ')', esc_parens)
+ | _ -> ('\"', '\"', esc_dquote)
+ in
+ Context.byte c open';
+ escaped_tight_block_lines c escapes lines;
+ Context.byte c close
+
+let link c (l : Inline.link) =
+ Context.byte c '[';
+ Context.inline c l.text;
+ Context.byte c ']';
+ Context.byte c '(';
+ (match l.url with
+ | None -> ()
+ | Some dest -> escaped_string c esc_parens dest);
+ Context.byte c ')'
+
+let image c l =
+ Context.byte c '!';
+ link c l
+let text c t = escaped_text c t
+
+let inline c = function
+ | Inline.Text t -> text c t
+ | Inline.Link l -> link c l
+ | Inline.Break -> break c
+ | Inline.Emphasis e -> emphasis c e
+ | Inline.Code_span cs -> code_span c cs
+ | Inline.Image i -> image c i
+ | Inline.Inlines is -> List.iter (Context.inline c) is
+ | Inline.Strong_emphasis e -> strong_emphasis c e
+ | Inline.Raw_html html -> List.iter (Context.string c) html
+
+let blank_line c l =
+ newline c;
+ indent c;
+ Context.string c l
+
+let string_node_option c = function None -> () | Some s -> Context.string c s
+
+let code_block c (cb : Block.code_block) =
+ let opening, closing =
+ let char, len = ('`', 3) in
+ let f = String.make len char in
+ (f, Some f)
+ in
+ let info_string = cb.info_string in
+ let code = cb.code in
+ newline c;
+ push_indent c (`I 0);
+ indent c;
+ Context.string c opening;
+ string_node_option c info_string;
+ if code <> [] then (
+ newline c;
+ indent c;
+ block_lines c code);
+ (match closing with
+ | None -> ()
+ | Some close ->
+ newline c;
+ indent c;
+ Context.string c close);
+ pop_indent c
+
+let heading c (h : Block.heading) =
+ newline c;
+ nchars c h.level '#';
+ if not (Inline.is_empty h.inline) then Context.byte c ' ' else ();
+ Context.inline c h.inline
+
+let html_block c h =
+ newline c;
+ indent c;
+ block_lines c h
+
+let unordered_item c marker i =
+ let before = 0 in
+ let after = 1 in
+ let task = None in
+ push_indent c (`L (before, marker, after, task));
+ Context.block c i;
+ pop_indent c
+
+let ordered_item c num i =
+ let before = 0 in
+ let marker = Int.to_string num ^ "." in
+ let after = 1 in
+ let task = None in
+ push_indent c (`L (before, marker, after, task));
+ Context.block c i;
+ pop_indent c;
+ num + 1
+
+let unordered_list c l = List.iter (unordered_item c "-") l
+
+let ordered_list c l = ignore (List.fold_left (ordered_item c) 1 l)
+
+let paragraph c p =
+ newline c;
+ indent c;
+ nchars c 0 ' ';
+ Context.inline c p;
+ Context.string c ""
+
+let table c t =
+ let col c i =
+ Context.byte c '|';
+ Context.byte c ' ';
+ Context.inline c i;
+ Context.byte c ' '
+ in
+ let sep c align =
+ let len = 3 in
+ Context.byte c '|';
+ Context.byte c ' ';
+ (match align with
+ | None -> nchars c len '-'
+ | Some `Left ->
+ Context.byte c ':';
+ nchars c (len - 1) '-'
+ | Some `Center ->
+ Context.byte c ':';
+ nchars c (len - 2) '-';
+ Context.byte c ':'
+ | Some `Right ->
+ nchars c (len - 1) '-';
+ Context.byte c ':');
+ Context.byte c ' '
+ in
+ let row c (row : Block.Table.row) =
+ match row with
+ | `Header cols | `Data cols ->
+ newline c;
+ indent c;
+ if cols = [] then Context.byte c '|' else List.iter (col c) cols;
+ Context.byte c '|'
+ | `Sep seps ->
+ newline c;
+ indent c;
+ if seps = [] then Context.byte c '|' else List.iter (sep c) seps;
+ Context.byte c '|'
+ in
+ List.iter (row c) (Block.Table.rows t)
+
+let block c = function
+ | Block.Blank_line -> blank_line c ""
+ | Block.Blocks bs -> List.iter (Context.block c) bs
+ | Block.Code_block cb -> code_block c cb
+ | Block.Heading h -> heading c h
+ | Block.Html_block h -> html_block c h
+ | Block.Unordered_list l -> unordered_list c l
+ | Block.Ordered_list l -> ordered_list c l
+ | Block.Paragraph p -> paragraph c p
+ | Block.Table t -> table c t
+
+let to_string d =
+ let t = { init_context; inline; block } in
+ let buffer = Buffer.create 1024 in
+ let ctx = Context.make t buffer in
+ Context.doc ctx d;
+ Buffer.contents buffer
diff --git a/src/odoc/bin/main.ml b/src/odoc/bin/main.ml
index 86c68f7b69..a1846cfa11 100644
--- a/src/odoc/bin/main.ml
+++ b/src/odoc/bin/main.ml
@@ -1314,6 +1314,18 @@ end
module Odoc_html = Make_renderer (Odoc_html_args)
+module Odoc_markdown_cmd = Make_renderer (struct
+ type args = Odoc_markdown.Config.t
+
+ let render config _sidebar page = Odoc_markdown.Generator.render ~config page
+
+ let filepath config url = Odoc_markdown.Generator.filepath ~config url
+
+ let extra_args =
+ Term.const { Odoc_markdown.Config.root_url = None; allow_html = true }
+ let renderer = { Odoc_document.Renderer.name = "markdown"; render; filepath }
+end)
+
module Odoc_html_url : sig
val cmd : unit Term.t
@@ -1755,6 +1767,8 @@ let () =
Compile_impl.(cmd, info ~docs:section_pipeline);
Indexing.(cmd, info ~docs:section_pipeline);
Sidebar.(cmd, info ~docs:section_pipeline);
+ Odoc_markdown_cmd.generate ~docs:section_pipeline;
+ Odoc_markdown_cmd.generate_source ~docs:section_pipeline;
Odoc_manpage.generate ~docs:section_generators;
Odoc_latex.generate ~docs:section_generators;
Odoc_html_url.(cmd, info ~docs:section_support);
diff --git a/src/odoc/dune b/src/odoc/dune
index 7e4c6e733d..40e4ab208f 100644
--- a/src/odoc/dune
+++ b/src/odoc/dune
@@ -5,6 +5,7 @@
compiler-libs.common
fpath
odoc_html
+ odoc_markdown
odoc_html_support_files
odoc_latex
odoc_loader
diff --git a/test/integration/markdown-with-belt.t/Belt.mli b/test/integration/markdown-with-belt.t/Belt.mli
new file mode 100644
index 0000000000..1887429f59
--- /dev/null
+++ b/test/integration/markdown-with-belt.t/Belt.mli
@@ -0,0 +1,105 @@
+(** A stdlib shipped with Melange
+
+ This stdlib is still in {i beta} but we encourage you to try it out and give
+ us feedback.
+
+ {b Motivation}
+
+ The motivation for creating such library is to provide Melange users a
+ better end-to-end user experience, since the original OCaml stdlib was not
+ written with JS in mind. Below is a list of areas this lib aims to improve:
+ + Consistency in name convention: camlCase, and arguments order
+ + Exception thrown functions are all suffixed with {i Exn}, e.g, {i getExn}
+ + Better performance and smaller code size running on JS platform
+
+ {b Name Convention}
+
+ For higher order functions, it will be suffixed {b U} if it takes uncurried
+ callback.
+
+ {[
+ val forEach : 'a t -> ('a -> unit) -> unit
+ val forEachU : 'a t -> ('a -> unit [\@u]) -> unit
+ ]}
+
+ In general, uncurried version will be faster, but it may be less familiar to
+ people who have a background in functional programming.
+
+ {b A special encoding for collection safety}
+
+ When we create a collection library for a custom data type we need a way to
+ provide a comparator function. Take {i Set} for example, suppose its element
+ type is a pair of ints, it needs a custom {i compare} function that takes
+ two tuples and returns their order. The {i Set} could not just be typed as
+ [ Set.t (int * int) ], its customized {i compare} function needs to manifest
+ itself in the signature, otherwise, if the user creates another customized
+ {i compare} function, the two collection could mix which would result in
+ runtime error.
+
+ The original OCaml stdlib solved the problem using {i functor} which creates
+ a big closure at runtime and makes dead code elimination much harder. We use
+ a phantom type to solve the problem:
+
+ {[
+ module Comparable1 = Belt.Id.MakeComparable (struct
+ type t = int * int
+ let cmp (a0, a1) (b0, b1) =
+ match Pervasives.compare a0 b0 with
+ | 0 -> Pervasives.compare a1 b1
+ | c -> c
+ end)
+
+ let mySet1 = Belt.Set.make ~id:(module Comparable1)
+
+ module Comparable2 = Belt.Id.MakeComparable (struct
+ type t = int * int
+ let cmp (a0, a1) (b0, b1) =
+ match Pervasives.compare a0 b0 with
+ | 0 -> Pervasives.compare a1 b1
+ | c -> c
+ end)
+
+ let mySet2 = Belt.Set.make ~id:(module Comparable2)
+ ]}
+
+ Here, the compiler would infer [mySet1] and [mySet2] having different type,
+ so e.g. a `merge` operation that tries to merge these two sets will
+ correctly fail.
+
+ {[
+ val mySet1 : (int * int, Comparable1.identity) t
+ val mySet2 : (int * int, Comparable2.identity) t
+ ]}
+
+ [Comparable1.identity] and [Comparable2.identity] are not the same using our
+ encoding scheme.
+
+ {b Collection Hierarchy}
+
+ In general, we provide a generic collection module, but also create
+ specialized modules for commonly used data type. Take {i Belt.Set} for
+ example, we provide:
+
+ {[
+ Belt.Set
+ Belt.Set.Int
+ Belt.Set.String
+ ]}
+
+ The specialized modules {i Belt.Set.Int}, {i Belt.Set.String} are in general
+ more efficient.
+
+ Currently, both {i Belt_Set} and {i Belt.Set} are accessible to users for
+ some technical reasons, we {b strongly recommend} users stick to qualified
+ import, {i Belt.Set}, we may hide the internal, {i i.e}, {i Belt_Set} in the
+ future *)
+
+module Id = Belt_Id
+
+(** {!Belt.Id}
+
+ Provide utilities to create identified comparators or hashes for data
+ structures used below.
+
+ It create a unique identifier per module of functions so that different data
+ structures with slightly different comparison functions won't mix *)
diff --git a/test/integration/markdown-with-belt.t/Belt_Id.mli b/test/integration/markdown-with-belt.t/Belt_Id.mli
new file mode 100644
index 0000000000..275e9f5a4e
--- /dev/null
+++ b/test/integration/markdown-with-belt.t/Belt_Id.mli
@@ -0,0 +1,10 @@
+(** {!Belt.Id}
+
+ Provide utilities to create identified comparators or hashes for data
+ structures used below.
+
+ It create a unique identifier per module of functions so that different data
+ structures with slightly different comparison functions won't mix *)
+
+type t
+(** [t] is the type of the identifier *)
diff --git a/test/integration/markdown-with-belt.t/run.t b/test/integration/markdown-with-belt.t/run.t
new file mode 100644
index 0000000000..5ef11363bb
--- /dev/null
+++ b/test/integration/markdown-with-belt.t/run.t
@@ -0,0 +1,92 @@
+ $ ocamlc -c -bin-annot Belt_Id.mli
+ $ ocamlc -c -bin-annot Belt.mli
+ $ odoc compile --package Belt -I . Belt.cmti
+ $ odoc compile --package Belt -I . Belt_Id.cmti
+
+ $ odoc link Belt.odoc
+ $ odoc link Belt_Id.odoc
+
+ $ odoc markdown-generate Belt.odocl -o markdown
+ $ odoc markdown-generate Belt_Id.odocl -o markdown
+
+ $ cat markdown/Belt/Belt.md
+
+ # Module `Belt`
+
+ A stdlib shipped with Melange
+
+ This stdlib is still in *beta* but we encourage you to try it out and give us feedback.
+
+ **Motivation**
+
+ The motivation for creating such library is to provide Melange users a better end-to-end user experience, since the original OCaml stdlib was not written with JS in mind. Below is a list of areas this lib aims to improve:
+
+ 1. Consistency in name convention: camlCase, and arguments order
+ 2. Exception thrown functions are all suffixed with *Exn*, e.g, *getExn*
+ 3. Better performance and smaller code size running on JS platform
+ **Name Convention**
+
+ For higher order functions, it will be suffixed **U** if it takes uncurried callback.
+
+ ```ocaml
+ val forEach : 'a t -> ('a -> unit) -> unit
+ val forEachU : 'a t -> ('a -> unit [\@u]) -> unit
+ ```
+ In general, uncurried version will be faster, but it may be less familiar to people who have a background in functional programming.
+
+ **A special encoding for collection safety**
+
+ When we create a collection library for a custom data type we need a way to provide a comparator function. Take *Set* for example, suppose its element type is a pair of ints, it needs a custom *compare* function that takes two tuples and returns their order. The *Set* could not just be typed as ` Set.t (int * int) `, its customized *compare* function needs to manifest itself in the signature, otherwise, if the user creates another customized *compare* function, the two collection could mix which would result in runtime error.
+
+ The original OCaml stdlib solved the problem using *functor* which creates a big closure at runtime and makes dead code elimination much harder. We use a phantom type to solve the problem:
+
+ ```ocaml
+ module Comparable1 = Belt.Id.MakeComparable (struct
+ type t = int * int
+ let cmp (a0, a1) (b0, b1) =
+ match Pervasives.compare a0 b0 with
+ | 0 -> Pervasives.compare a1 b1
+ | c -> c
+ end)
+
+ let mySet1 = Belt.Set.make ~id:(module Comparable1)
+
+ module Comparable2 = Belt.Id.MakeComparable (struct
+ type t = int * int
+ let cmp (a0, a1) (b0, b1) =
+ match Pervasives.compare a0 b0 with
+ | 0 -> Pervasives.compare a1 b1
+ | c -> c
+ end)
+
+ let mySet2 = Belt.Set.make ~id:(module Comparable2)
+ ```
+ Here, the compiler would infer `mySet1` and `mySet2` having different type, so e.g. a \`merge\` operation that tries to merge these two sets will correctly fail.
+
+ ```ocaml
+ val mySet1 : (int * int, Comparable1.identity) t
+ val mySet2 : (int * int, Comparable2.identity) t
+ ```
+ `Comparable1.identity` and `Comparable2.identity` are not the same using our encoding scheme.
+
+ **Collection Hierarchy**
+
+ In general, we provide a generic collection module, but also create specialized modules for commonly used data type. Take *Belt.Set* for example, we provide:
+
+ ```ocaml
+ Belt.Set
+ Belt.Set.Int
+ Belt.Set.String
+ ```
+ The specialized modules *Belt.Set.Int*, *Belt.Set.String* are in general more efficient.
+
+ Currently, both *Belt\_Set* and *Belt.Set* are accessible to users for some technical reasons, we **strongly recommend** users stick to qualified import, *Belt.Set*, we may hide the internal, *i.e*, *Belt\_Set* in the future
+
+ ```
+ module Id = Belt_Id
+ ```
+ [`Belt.Id`](./Belt_Id.md)
+
+ Provide utilities to create identified comparators or hashes for data structures used below.
+
+ It create a unique identifier per module of functions so that different data structures with slightly different comparison functions won't mix
diff --git a/test/integration/markdown.t/array.mli b/test/integration/markdown.t/array.mli
new file mode 100644
index 0000000000..9cd2006544
--- /dev/null
+++ b/test/integration/markdown.t/array.mli
@@ -0,0 +1,39 @@
+(** {0 Array}
+
+ Utilities for Array data type.
+
+ This module is compatible with original ocaml stdlib. In general, all
+ functions comes with the original stdlib also applies to this collection,
+ however, this module provides faster and stack safer utilities *)
+
+type 'a t = 'a list
+(** ['a t] is compatible with built-in [list] type *)
+
+(** {2 length} *)
+
+val make : 'a t -> int
+(** [length xs]
+
+ @return the length of the list [xs] *)
+
+(** {2 size} *)
+
+val size : 'a t -> int
+(** {b See} {!length} *)
+
+(** {2 head} *)
+
+val head : 'a t -> 'a option
+(** [head xs] returns [None] if [xs] is the empty list, otherwise it returns
+ [Some value] where [val ue] is the first element in the list.
+ {[
+ head [] = None;;
+ head [ 1; 2; 3 ] = Some 1
+ ]} *)
+
+val headExn : 'a t -> 'a
+(** [headExn xs]
+
+ {b See} {!head}
+
+ {b raise} an exception if [xs] is empty *)
diff --git a/test/integration/markdown.t/list.mli b/test/integration/markdown.t/list.mli
new file mode 100644
index 0000000000..8613eda85f
--- /dev/null
+++ b/test/integration/markdown.t/list.mli
@@ -0,0 +1,39 @@
+(** {0 List}
+
+ Utilities for List data type.
+
+ This module is compatible with original ocaml stdlib. In general, all
+ functions comes with the original stdlib also applies to this collection,
+ however, this module provides faster and stack safer utilities *)
+
+type 'a t = 'a list
+(** ['a t] is compatible with built-in [list] type *)
+
+(** {2 length} *)
+
+val make : 'a t -> int
+(** [length xs]
+
+ @return the length of the list [xs] *)
+
+(** {2 size} *)
+
+val size : 'a t -> int
+(** {b See} {!length} *)
+
+(** {2 head} *)
+
+val head : 'a t -> 'a option
+(** [head xs] returns [None] if [xs] is the empty list, otherwise it returns
+ [Some value] where [value] is the first element in the list.
+ {[
+ head [] = None;;
+ head [ 1; 2; 3 ] = Some 1
+ ]} *)
+
+val headExn : 'a t -> 'a
+(** [headExn xs]
+
+ {b See} {!head}
+
+ {b raise} an exception if [xs] is empty *)
diff --git a/test/integration/markdown.t/odoc_logo_placeholder.jpg b/test/integration/markdown.t/odoc_logo_placeholder.jpg
new file mode 100644
index 0000000000..129c4cd6f7
Binary files /dev/null and b/test/integration/markdown.t/odoc_logo_placeholder.jpg differ
diff --git a/test/integration/markdown.t/page.mld b/test/integration/markdown.t/page.mld
new file mode 100644
index 0000000000..ecb1173b29
--- /dev/null
+++ b/test/integration/markdown.t/page.mld
@@ -0,0 +1,126 @@
+{0 The title}
+
+Quick reference for the odoc language rendering markdown
+
+{1 Title}
+{2 Subtitle}
+{3:my_id Referenceable title}
+
+See {!my_id}.
+
+{3:styled Styled}
+
+{b bold} text, {i italic} text, {e emphasized} text
+
+H{_ 2}O and 1{^ st}
+
+{3 Link}
+
+Here is a link: {:https://www.example.com}.
+
+You can also click {{:https://www.example.com}here}.
+
+{3 References}
+
+See an empty reference {{!test.v}}.
+
+See {{!test.v}this function from another library}.
+
+See {{!./test.mli}this page from another package}.
+
+See {{!styled}this section} for the syntax of references.
+
+{4 Subpages}
+
+There's a subpage here {{!test}} and another one {{!test2}}
+
+{3 Lists}
+
+- First item
+- Second item
+
++ First ordered item
++ Second numbered item
+
+{ul
+ {- First item}
+ {- Second item}
+ {li can also be used}}
+
+{ol
+ {- First numbered item}
+ {- Second numbered item}
+ {li can also be used}}
+
+{3 Code blocks}
+
+Inline [code].
+
+{[
+let _ = "Block code"
+]}
+
+{foo@text[
+Code block with {[inner code block syntax]}
+]foo}
+
+{@python[
+[i+1 for i in xrange(2)]
+]}
+
+{3 Verbatim}
+
+{v verbatim text v}
+
+{3 Math}
+
+For inline math: {m \sqrt 2}.
+
+For display math:
+
+{math \sqrt 2}
+
+{3 Images}
+
+{image!odoc_logo_placeholder.jpg}
+{image:https://picsum.photos/200/100}
+
+{3 Table}
+
+{4 Explicit syntax}
+
+{table
+ {tr
+ {th Header 1}
+ {th Header 2}}
+ {tr
+ {td Cell 1}
+ {td Cell 2}}
+ {tr
+ {td Cell 3}
+ {td Cell 4}}}]}
+
+{4 Light syntax}
+
+{t | Header 1 | Header 2 |
+ |----------|----------|
+ | Cell 1 | Cell 2 |
+ | Cell 3 | Cell 4 |}
+
+{3 HTML}
+
+This is a strong tag: {%html: Odoc language lack support for quotation!
+%}
+
+{%html:
+
+
+ Odoc language lack support for quotation!
+
+
+
+ Odoc language lack support for quotation!
+
+