2403

Committed 02 Oct 2024 03:15PM UTC coverage: 72.971% (+0.1%) from 72.848%

Build # 2403

Build Type

Pull #1193

github

Committed by

web-flow

Commit Message

Merge 93aa604a2 into 0ba1fdbe6

Pull Request Pull Request #1193: Specify children order in frontmatter

Run Details

140 of 154 new or added lines in 10 files covered. (90.91%)

60 existing lines in 5 files now uncovered.

10248 of 14044 relevant lines covered (72.97%)

2965.35 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

85.66

/src/latex/generator.ml

open Odoc_document.Types
open Types
module Doctree = Odoc_document.Doctree
module Url = Odoc_document.Url

module Link = struct
  let rec flatten_path ppf (x : Odoc_document.Url.Path.t) =
    let pp_parent ppf = function
      | Some p -> Format.fprintf ppf "%a-" flatten_path p
      | None -> ()
    in
    Format.fprintf ppf "%a%a%s" pp_parent x.parent
      Url.Path.pp_disambiguating_prefix x.kind x.name

  let page p = Format.asprintf "%a" flatten_path p

  let label (x : Odoc_document.Url.t) =
    match x.anchor with
    | "" -> page x.page
    | anchor -> Format.asprintf "%a-%s" flatten_path x.page anchor

  let rec is_class_or_module_path (url : Odoc_document.Url.Path.t) =
    match url.kind with
    | `Module | `LeafPage | `Class | `Page -> (
        match url.parent with
        | None -> true
        | Some url -> is_class_or_module_path url)
    | _ -> false

  let should_inline status url =
    match status with
    | `Inline | `Open -> true
    | `Closed -> false
    | `Default -> not @@ is_class_or_module_path url

  let get_dir_and_file url =
    let open Odoc_document in
    let l = Url.Path.to_list url in
    let is_dir = function `Page -> `IfNotLast | _ -> `Never in
    let dir, file = Url.Path.split ~is_dir l in
    let segment_to_string (_kind, name) = name in
    ( List.map segment_to_string dir,
      String.concat "." (List.map segment_to_string file) )

  let filename ?(add_ext = true) url =
    let dir, file = get_dir_and_file url in
    let file = Fpath.(v (String.concat dir_sep (dir @ [ file ]))) in
    if add_ext then Fpath.add_ext "tex" file else file
end

let style = function
  | `Emphasis | `Italic -> Raw.emph
  | `Bold -> Raw.bold
  | `Subscript -> Raw.subscript
  | `Superscript -> Raw.superscript

let gen_hyperref pp r ppf =
  match (r.target, r.text) with
  | "", None -> ()
  | "", Some content -> Raw.inline_code pp ppf content
  | s, None -> Raw.ref ppf s
  | s, Some content ->
      let pp =
        if r.short then Raw.inline_code pp
        else fun ppf x ->
          Fmt.pf ppf "%a[p%a]" (Raw.inline_code pp) x Raw.pageref_star s
      in
      Raw.hyperref s pp ppf content

let label = function
  | None -> []
  | Some x (* {Odoc_document.Url.Anchor.anchor ; page;  _ }*) ->
      [ Label (Link.label x) ]

let level_macro = function
  | 0 -> Raw.section
  | 1 -> Raw.subsection
  | 2 -> Raw.subsubsection
  | 3 | _ -> Raw.subsubsection

let none _ppf () = ()

let list kind pp ppf x =
  let list =
    match kind with Block.Ordered -> Raw.enumerate | Unordered -> Raw.itemize
  in
  let elt ppf = Raw.item pp ppf in
  match x with
  | [] -> (* empty list are not supported *) ()
  | _ -> list (Fmt.list ~sep:(fun ppf () -> Raw.break ppf Aesthetic) elt) ppf x

let escape_entity = function "#45" -> "-" | "gt" -> ">" | s -> s

let elt_size (x : elt) =
  match x with
  | Txt _ | Internal_ref _ | External_ref _ | Label _ | Style _ | Inlined_code _
  | Code_fragment _ | Tag _ | Break _ | Ligaturable _ ->
      Small
  | List _ | Section _ | Verbatim _ | Raw _ | Code_block _ | Indented _
  | Description _ ->
      Large
  | Table _ | Layout_table _ -> Huge

let layout_table = function
  | [] -> []
  | a :: _ as m ->
      let start = List.map (fun _ -> Empty) a in
      let content_size l =
        List.fold_left (fun s x -> max s (elt_size x)) Empty l
      in
      let row mask l = List.map2 (fun x y -> max x @@ content_size y) mask l in
      let mask = List.fold_left row start m in
      let filter_empty = function
        | Empty, _ -> None
        | (Small | Large | Huge), x -> Some x
      in
      let filter_row row =
        Odoc_utils.List.filter_map filter_empty @@ List.combine mask row
      in
      let row_size = List.fold_left max Empty mask in
      [ Layout_table { row_size; tbl = List.map filter_row m } ]

let txt ~verbatim ~in_source ws =
  if verbatim then [ Txt ws ]
  else
    let escaped = List.map (Raw.Escape.text ~code_hyphenation:in_source) ws in
    match List.filter (( <> ) "") escaped with [] -> [] | l -> [ Txt l ]

let entity ~in_source ~verbatim x =
  if in_source && not verbatim then Ligaturable (escape_entity x)
  else Txt [ escape_entity x ]

(** Tables with too many rows are hard to typeset correctly on
    the same page.
    Splitting tables on multiple pages is unreliable with longtable + hyperref.
    Thus we limit the height of the tables that we render as latex tables.
    This variable is kept separated because we may want to make it tunable
    by the user.
*)
let small_table_height_limit = 10

let rec pp_elt ppf = function
  | Txt words -> Fmt.list Fmt.string ~sep:none ppf words
  | Section { level; label; content } ->
      let with_label ppf (label, content) =
        pp ppf content;
        match label with None -> () | Some label -> Raw.label ppf label
      in
      level_macro level with_label ppf (label, content)
  | Break lvl -> Raw.break ppf lvl
  | Raw s -> Fmt.string ppf s
  | Verbatim s -> Raw.verbatim ppf s
  | Internal_ref r -> hyperref ppf r
  | External_ref (l, x) -> href ppf (l, x)
  | Style (s, x) -> style s pp ppf x
  | Code_block [] -> ()
  | Code_block x -> Raw.code_block pp ppf x
  | Inlined_code x -> Raw.inline_code pp ppf x
  | Code_fragment x -> Raw.code_fragment pp ppf x
  | List { typ; items } -> list typ pp ppf items
  | Description items -> Raw.description pp ppf items
  | Table { align; data } -> Raw.small_table pp ppf (Some align, data)
  | Layout_table { row_size = Large | Huge; tbl } -> large_table ppf tbl
  | Layout_table { row_size = Small | Empty; tbl } ->
      if List.length tbl <= small_table_height_limit then
        Raw.small_table pp ppf (None, tbl)
      else large_table ppf tbl
  | Label x -> Raw.label ppf x
  | Indented x -> Raw.indent pp ppf x
  | Ligaturable s -> Fmt.string ppf s
  | Tag (s, t) -> tag s ppf t

and pp ppf = function
  | [] -> ()
  | Break _ :: ((Layout_table _ | Table _) :: _ as q) -> pp ppf q
  | ((Layout_table _ | Table _) as t) :: Break _ :: q -> pp ppf (t :: q)
  | Break a :: Break b :: q -> pp ppf (Break (max a b) :: q)
  | Ligaturable "-" :: Ligaturable ">" :: q ->
      Raw.rightarrow ppf;
      pp ppf q
  | a :: q ->
      pp_elt ppf a;
      pp ppf q

and hyperref ppf r = gen_hyperref pp r ppf

and href ppf (l, txt) =
  match txt with
  | Some txt ->
      Raw.href l pp ppf txt;
      Raw.footnote ppf l
  | None -> Raw.url ppf l

and large_table ppf tbl =
  let rec row ppf = function
    | [] -> Raw.break ppf Line
    | [ a ] ->
        pp ppf a;
        Raw.break ppf Line
    | [ a; b ] -> Fmt.pf ppf "%a%a%a" pp a Raw.break Aesthetic (Raw.indent pp) b
    | a :: (_ :: _ as q) ->
        Fmt.pf ppf "%a%a%a" pp a Raw.break Aesthetic (Raw.indent row) q
  in
  let matrix ppf m = List.iter (row ppf) m in
  Raw.indent matrix ppf tbl

and tag s ppf x = Raw.ocamltag s pp ppf x

let raw_markup (t : Raw_markup.t) =
  let target, content = t in
  match Astring.String.Ascii.lowercase target with
  | "latex" | "tex" -> [ Raw content ]
  | _ -> []

let source k (t : Source.t) =
  let rec token (x : Source.token) =
    match x with
    | Elt i -> k i
    | Tag (None, l) -> tokens l
    | Tag (Some s, l) -> [ Tag (s, tokens l) ]
  and tokens t = Odoc_utils.List.concat_map t ~f:token in
  tokens t

let rec internalref ~verbatim ~in_source (t : Target.internal) (c : Inline.t) =
  let target =
    match t with
    | Target.Resolved uri -> Link.label uri
    | Unresolved -> "xref-unresolved"
  in
  let text = Some (inline ~verbatim ~in_source c) in
  let short = in_source in
  Internal_ref { short; target; text }

and inline ~in_source ~verbatim (l : Inline.t) =
  let one (t : Inline.one) =
    match t.desc with
    | Text _s -> assert false
    | Linebreak -> [ Break Line ]
    | Styled (style, c) -> [ Style (style, inline ~verbatim ~in_source c) ]
    | Link { target = External ext; content = c; _ } ->
        let content = inline ~verbatim:false ~in_source:false c in
        [ External_ref (ext, Some content) ]
    | Link { target = Internal ref_; content = c; _ } ->
        [ internalref ~in_source ~verbatim ref_ c ]
    | Source c ->
        [ Inlined_code (source (inline ~verbatim:false ~in_source:true) c) ]
    | Math s -> [ Raw (Format.asprintf "%a" Raw.math s) ]
    | Raw_markup r -> raw_markup r
    | Entity s -> [ entity ~in_source ~verbatim s ]
  in

  let take_text (l : Inline.t) =
    Doctree.Take.until l ~classify:(function
      | { Inline.desc = Text code; _ } -> Accum [ code ]
      | { desc = Entity e; _ } -> Accum [ escape_entity e ]
      | _ -> Stop_and_keep)
  in
  (* if in_source then block_code_txt s else if_not_empty (fun x -> Txt x) s *)
  let rec prettify = function
    | { Inline.desc = Inline.Text _; _ } :: _ as l ->
        let words, _, rest = take_text l in
        txt ~in_source ~verbatim words @ prettify rest
    | o :: q -> one o @ prettify q
    | [] -> []
  in
  prettify l

let heading (h : Heading.t) =
  let content = inline ~in_source:false ~verbatim:false h.title in
  [ Section { label = h.label; level = h.level; content }; Break Aesthetic ]

let non_empty_block_code c =
  let s = source (inline ~verbatim:true ~in_source:true) c in
  match s with
  | [] -> []
  | _ :: _ as l -> [ Break Separation; Code_block l; Break Separation ]

let non_empty_code_fragment c =
  let s = source (inline ~verbatim:false ~in_source:true) c in
  match s with [] -> [] | _ :: _ as l -> [ Code_fragment l ]

let rec block ~in_source (l : Block.t) =
  let one (t : Block.one) =
    match t.desc with
    | Inline i -> inline ~verbatim:false ~in_source:false i
    | Audio (_, content) | Video (_, content) | Image (_, content) ->
        txt ~verbatim:false ~in_source:false [ content ]
        @ if in_source then [] else [ Break Paragraph ]
    | Paragraph i ->
        inline ~in_source:false ~verbatim:false i
        @ if in_source then [] else [ Break Paragraph ]
    | List (typ, l) ->
        [ List { typ; items = List.map (block ~in_source:false) l } ]
    | Table t -> table_block t
    | Description l ->
        [
          (let item i =
             ( inline ~in_source ~verbatim:false i.Description.key,
               block ~in_source i.Description.definition )
           in
           Description (List.map item l));
        ]
    | Raw_markup r -> raw_markup r
    | Verbatim s -> [ Verbatim s ]
    | Source (_, c) -> non_empty_block_code c
    | Math s ->
        [
          Break Paragraph;
          Raw (Format.asprintf "%a" Raw.equation s);
          Break Paragraph;
        ]
  in
  Odoc_utils.List.concat_map l ~f:one

and table_block { Table.data; align } =
  let data =
    List.map
      (List.map (fun (cell, cell_type) ->
           let content = block ~in_source:false cell in
           match cell_type with
           | `Header -> [ Style (`Bold, content) ]
           | `Data -> content))
      data
  in
  [ Table { align; data } ]

let rec is_only_text l =
  let is_text : Item.t -> _ = function
    | Heading _ | Text _ -> true
    | Declaration _ -> false
    | Include { content = items; _ } -> is_only_text items.content
  in
  List.for_all is_text l

let rec documentedSrc (t : DocumentedSrc.t) =
  let open DocumentedSrc in
  let rec to_latex t =
    match t with
    | [] -> []
    | Code _ :: _ ->
        let take_code l =
          Doctree.Take.until l ~classify:(function
            | Code code -> Accum code
            | _ -> Stop_and_keep)
        in
        let code, _, rest = take_code t in
        non_empty_code_fragment code @ to_latex rest
    | Alternative (Expansion e) :: rest ->
        (if Link.should_inline e.status e.url then to_latex e.expansion
         else non_empty_code_fragment e.summary)
        @ to_latex rest
    | Subpage subp :: rest ->
        Indented (items subp.content.items) :: to_latex rest
    | (Documented _ | Nested _) :: _ ->
        let take_descr l =
          Doctree.Take.until l ~classify:(function
            | Documented { attrs; anchor; code; doc; markers } ->
                Accum
                  [
                    {
                      DocumentedSrc.attrs;
                      anchor;
                      code = `D code;
                      doc;
                      markers;
                    };
                  ]
            | Nested { attrs; anchor; code; doc; markers } ->
                Accum
                  [
                    {
                      DocumentedSrc.attrs;
                      anchor;
                      code = `N code;
                      doc;
                      markers;
                    };
                  ]
            | _ -> Stop_and_keep)
        in
        let l, _, rest = take_descr t in
        let one dsrc =
          let content =
            match dsrc.code with
            | `D code -> inline ~verbatim:false ~in_source:true code
            | `N n -> to_latex n
          in
          let doc = [ block ~in_source:true dsrc.doc ] in
          (content @ label dsrc.anchor) :: doc
        in
        layout_table (List.map one l) @ to_latex rest
  in
  to_latex t

and items l =
  let rec walk_items ~only_text acc (t : Item.t list) =
    let continue_with rest elts =
      walk_items ~only_text (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
            | Item.Text text -> Accum text
            | _ -> Stop_and_keep)
        in
        let content = block ~in_source:false text in
        let elts = content in
        elts |> continue_with rest
    | Heading h :: rest -> heading h |> continue_with rest
    | Include
        {
          attr = _;
          source_anchor = _;
          anchor;
          doc;
          content = { summary; status = _; content };
        }
      :: rest ->
        let included = items content in
        let docs = block ~in_source:true doc in
        let summary = source (inline ~verbatim:false ~in_source:true) summary in
        let content = included in
        label anchor @ docs @ summary @ content |> continue_with rest
    | Declaration { Item.attr = _; source_anchor = _; anchor; content; doc }
      :: rest ->
        let content = label anchor @ documentedSrc content in
        let elts =
          match doc with
          | [] -> content @ [ Break Line ]
          | docs ->
              content
              @ [ Indented (block ~in_source:true docs); Break Separation ]
        in
        continue_with rest elts
  and items l = walk_items ~only_text:(is_only_text l) [] l in
  items l

module Doc = struct
  let link_children ppf children =
    let input_child ppf child =
      Raw.input ppf child.Odoc_document.Renderer.filename
    in
    Fmt.list input_child ppf children

  let make ~with_children url content children =
    let filename = Link.filename url in
    let label = Label (Link.page url) in
    let content =
      match content with
      | [] -> [ label ]
      | (Section _ as s) :: q -> s :: label :: q
      | q -> label :: q
    in
    let children_input ppf =
      if with_children then link_children ppf children else ()
    in
    let content ppf = Fmt.pf ppf "@[<v>%a@,%t@]@." pp content children_input in
    { Odoc_document.Renderer.filename; content; children }
end

module Page = struct
  let on_sub = function `Page _ -> Some 1 | `Include _ -> None

  let rec subpage ~with_children (p : Subpage.t) =
    if Link.should_inline p.status p.content.url then []
    else [ page ~with_children p.content ]

  and subpages ~with_children subpages =
    List.flatten @@ List.map (subpage ~with_children) subpages

  and page ~with_children p =
    let { Page.preamble; items = i; url; _ } =
      Doctree.Labels.disambiguate_page ~enter_subpages:true p
    and subpages = subpages ~with_children @@ Doctree.Subpages.compute p in
    let i = Doctree.Shift.compute ~on_sub i in
    let header = items (Doctree.PageTitle.render_title p @ preamble) in
    let content = items i in
    let page = Doc.make ~with_children url (header @ content) subpages in
    page
end

let render ~with_children = function
  | Document.Page page -> [ Page.page ~with_children page ]
  | Source_page _ -> []

let filepath url = Link.filename ~add_ext:false url

1	open Odoc_document.Types
2	open Types
3	module Doctree = Odoc_document.Doctree
4	module Url = Odoc_document.Url
5
6	module Link = struct
7	let rec flatten_path ppf (x : Odoc_document.Url.Path.t) =
8	let pp_parent ppf = function	7,757✔
9	\| Some p -> Format.fprintf ppf "%a-" flatten_path p	4,035✔
10	\| None -> ()	3,722✔
11	in
12	Format.fprintf ppf "%a%a%s" pp_parent x.parent
13	Url.Path.pp_disambiguating_prefix x.kind x.name
14
15	let page p = Format.asprintf "%a" flatten_path p	1,198✔
16
17	let label (x : Odoc_document.Url.t) =
18	match x.anchor with	3,553✔
19	\| "" -> page x.page	1,029✔
20	\| anchor -> Format.asprintf "%a-%s" flatten_path x.page anchor	2,524✔
21
22	let rec is_class_or_module_path (url : Odoc_document.Url.Path.t) =
23	match url.kind with	1,059✔
UNCOV 24	\| `Module \| `LeafPage \| `Class \| `Page -> (	×
25	match url.parent with
26	\| None -> true	216✔
27	\| Some url -> is_class_or_module_path url)	326✔
28	\| _ -> false	517✔
29
30	let should_inline status url =
31	match status with	1,081✔
UNCOV 32	\| `Inline \| `Open -> true	×
UNCOV 33	\| `Closed -> false	×
34	\| `Default -> not @@ is_class_or_module_path url	733✔
35
36	let get_dir_and_file url =
37	let open Odoc_document in	169✔
38	let l = Url.Path.to_list url in
39	let is_dir = function `Page -> `IfNotLast \| _ -> `Never in	10✔
40	let dir, file = Url.Path.split ~is_dir l in
41	let segment_to_string (_kind, name) = name in	169✔
42	( List.map segment_to_string dir,	169✔
43	String.concat "." (List.map segment_to_string file) )	169✔
44
45	let filename ?(add_ext = true) url =	169✔
46	let dir, file = get_dir_and_file url in	169✔
47	let file = Fpath.(v (String.concat dir_sep (dir @ [ file ]))) in	169✔
UNCOV 48	if add_ext then Fpath.add_ext "tex" file else file	×
49	end
50
51	let style = function
52	\| `Emphasis \| `Italic -> Raw.emph	13✔
53	\| `Bold -> Raw.bold	27✔
54	\| `Subscript -> Raw.subscript	7✔
55	\| `Superscript -> Raw.superscript	7✔
56
57	let gen_hyperref pp r ppf =
58	match (r.target, r.text) with	794✔
59	\| "", None -> ()	×
UNCOV 60	\| "", Some content -> Raw.inline_code pp ppf content	×
UNCOV 61	\| s, None -> Raw.ref ppf s	×
62	\| s, Some content ->	794✔
63	let pp =
64	if r.short then Raw.inline_code pp	702✔
65	else fun ppf x ->	92✔
66	Fmt.pf ppf "%a[p%a]" (Raw.inline_code pp) x Raw.pageref_star s	92✔
67	in
68	Raw.hyperref s pp ppf content
69
70	let label = function
71	\| None -> []	68✔
72	\| Some x (* {Odoc_document.Url.Anchor.anchor ; page; _ }*) ->	1,977✔
73	[ Label (Link.label x) ]	1,977✔
74
75	let level_macro = function
76	\| 0 -> Raw.section	89✔
77	\| 1 -> Raw.subsection	83✔
78	\| 2 -> Raw.subsubsection	33✔
79	\| 3 \| _ -> Raw.subsubsection	6✔
80
81	let none _ppf () = ()	4,496✔
82
83	let list kind pp ppf x =
84	let list =	22✔
85	match kind with Block.Ordered -> Raw.enumerate \| Unordered -> Raw.itemize	4✔
86	in
87	let elt ppf = Raw.item pp ppf in	68✔
88	match x with
UNCOV 89	\| [] -> (* empty list are not supported *) ()	×
90	\| _ -> list (Fmt.list ~sep:(fun ppf () -> Raw.break ppf Aesthetic) elt) ppf x	22✔
91
UNCOV 92	let escape_entity = function "#45" -> "-" \| "gt" -> ">" \| s -> s	×
93
94	let elt_size (x : elt) =
95	match x with	618✔
UNCOV 96	\| Txt _ \| Internal_ref _ \| External_ref _ \| Label _ \| Style _ \| Inlined_code _	×
97	\| Code_fragment _ \| Tag _ \| Break _ \| Ligaturable _ ->	×
98	Small
UNCOV 99	\| List _ \| Section _ \| Verbatim _ \| Raw _ \| Code_block _ \| Indented _	×
100	\| Description _ ->	×
101	Large
UNCOV 102	\| Table _ \| Layout_table _ -> Huge	×
103
104	let layout_table = function
UNCOV 105	\| [] -> []	×
106	\| a :: _ as m ->	140✔
107	let start = List.map (fun _ -> Empty) a in	280✔
108	let content_size l =	140✔
109	List.fold_left (fun s x -> max s (elt_size x)) Empty l	500✔
110	in
111	let row mask l = List.map2 (fun x y -> max x @@ content_size y) mask l in	250✔
112	let mask = List.fold_left row start m in
113	let filter_empty = function	140✔
114	\| Empty, _ -> None	162✔
UNCOV 115	\| (Small \| Large \| Huge), x -> Some x	×
116	in
117	let filter_row row =
118	Odoc_utils.List.filter_map filter_empty @@ List.combine mask row	250✔
119	in
120	let row_size = List.fold_left max Empty mask in
121	[ Layout_table { row_size; tbl = List.map filter_row m } ]	140✔
122
123	let txt ~verbatim ~in_source ws =
124	if verbatim then [ Txt ws ]	2✔
125	else
126	let escaped = List.map (Raw.Escape.text ~code_hyphenation:in_source) ws in	46,047✔
127	match List.filter (( <> ) "") escaped with [] -> [] \| l -> [ Txt l ]	16,706✔
128
129	let entity ~in_source ~verbatim x =
130	if in_source && not verbatim then Ligaturable (escape_entity x)	260✔
UNCOV 131	else Txt [ escape_entity x ]	×
132
133	(** Tables with too many rows are hard to typeset correctly on
134	the same page.
135	Splitting tables on multiple pages is unreliable with longtable + hyperref.
136	Thus we limit the height of the tables that we render as latex tables.
137	This variable is kept separated because we may want to make it tunable
138	by the user.
139	*)
140	let small_table_height_limit = 10
141
142	let rec pp_elt ppf = function
143	\| Txt words -> Fmt.list Fmt.string ~sep:none ppf words	8,394✔
144	\| Section { level; label; content } ->	234✔
145	let with_label ppf (label, content) =
146	pp ppf content;	234✔
147	match label with None -> () \| Some label -> Raw.label ppf label	83✔
148	in
149	level_macro level with_label ppf (label, content)
150	\| Break lvl -> Raw.break ppf lvl	1,254✔
151	\| Raw s -> Fmt.string ppf s	3✔
152	\| Verbatim s -> Raw.verbatim ppf s	3✔
153	\| Internal_ref r -> hyperref ppf r	794✔
154	\| External_ref (l, x) -> href ppf (l, x)	16✔
155	\| Style (s, x) -> style s pp ppf x	79✔
UNCOV 156	\| Code_block [] -> ()	×
157	\| Code_block x -> Raw.code_block pp ppf x	1✔
158	\| Inlined_code x -> Raw.inline_code pp ppf x	346✔
159	\| Code_fragment x -> Raw.code_fragment pp ppf x	1,633✔
160	\| List { typ; items } -> list typ pp ppf items	22✔
161	\| Description items -> Raw.description pp ppf items	42✔
162	\| Table { align; data } -> Raw.small_table pp ppf (Some align, data)	5✔
UNCOV 163	\| Layout_table { row_size = Large \| Huge; tbl } -> large_table ppf tbl	×
UNCOV 164	\| Layout_table { row_size = Small \| Empty; tbl } ->	×
165	if List.length tbl <= small_table_height_limit then	66✔
166	Raw.small_table pp ppf (None, tbl)	66✔
UNCOV 167	else large_table ppf tbl	×
168	\| Label x -> Raw.label ppf x	1,081✔
169	\| Indented x -> Raw.indent pp ppf x	486✔
UNCOV 170	\| Ligaturable s -> Fmt.string ppf s	×
171	\| Tag (s, t) -> tag s ppf t	2,133✔
172
173	and pp ppf = function
174	\| [] -> ()	6,174✔
UNCOV 175	\| Break _ :: ((Layout_table _ \| Table _) :: _ as q) -> pp ppf q	×
UNCOV 176	\| ((Layout_table _ \| Table _) as t) :: Break _ :: q -> pp ppf (t :: q)	×
177	\| Break a :: Break b :: q -> pp ppf (Break (max a b) :: q)	2✔
178	\| Ligaturable "-" :: Ligaturable ">" :: q ->	65✔
179	Raw.rightarrow ppf;
180	pp ppf q	65✔
181	\| a :: q ->	16,596✔
182	pp_elt ppf a;
183	pp ppf q	16,596✔
184
185	and hyperref ppf r = gen_hyperref pp r ppf	794✔
186
187	and href ppf (l, txt) =
188	match txt with	16✔
189	\| Some txt ->	16✔
190	Raw.href l pp ppf txt;
191	Raw.footnote ppf l	16✔
UNCOV 192	\| None -> Raw.url ppf l	×
193
194	and large_table ppf tbl =
195	let rec row ppf = function	4✔
UNCOV 196	\| [] -> Raw.break ppf Line	×
197	\| [ a ] ->	2✔
198	pp ppf a;
199	Raw.break ppf Line	2✔
200	\| [ a; b ] -> Fmt.pf ppf "%a%a%a" pp a Raw.break Aesthetic (Raw.indent pp) b	8✔
UNCOV 201	\| a :: (_ :: _ as q) ->	×
UNCOV 202	Fmt.pf ppf "%a%a%a" pp a Raw.break Aesthetic (Raw.indent row) q	×
203	in
204	let matrix ppf m = List.iter (row ppf) m in	4✔
205	Raw.indent matrix ppf tbl
206
207	and tag s ppf x = Raw.ocamltag s pp ppf x	2,133✔
208
209	let raw_markup (t : Raw_markup.t) =
210	let target, content = t in	6✔
211	match Astring.String.Ascii.lowercase target with
UNCOV 212	\| "latex" \| "tex" -> [ Raw content ]	×
213	\| _ -> []	4✔
214
215	let source k (t : Source.t) =
216	let rec token (x : Source.token) =	4,686✔
217	match x with	55,864✔
218	\| Elt i -> k i	44,173✔
219	\| Tag (None, l) -> tokens l	7,440✔
220	\| Tag (Some s, l) -> [ Tag (s, tokens l) ]	4,251✔
221	and tokens t = Odoc_utils.List.concat_map t ~f:token in	16,377✔
222	tokens t
223
224	let rec internalref ~verbatim ~in_source (t : Target.internal) (c : Inline.t) =
225	let target =	1,585✔
226	match t with
227	\| Target.Resolved uri -> Link.label uri	1,575✔
228	\| Unresolved -> "xref-unresolved"	10✔
229	in
230	let text = Some (inline ~verbatim ~in_source c) in	1,585✔
231	let short = in_source in
232	Internal_ref { short; target; text }
233
234	and inline ~in_source ~verbatim (l : Inline.t) =
235	let one (t : Inline.one) =	47,459✔
236	match t.desc with	2,705✔
237	\| Text _s -> assert false
UNCOV 238	\| Linebreak -> [ Break Line ]	×
239	\| Styled (style, c) -> [ Style (style, inline ~verbatim ~in_source c) ]	134✔
240	\| Link { target = External ext; content = c; _ } ->	32✔
241	let content = inline ~verbatim:false ~in_source:false c in
242	[ External_ref (ext, Some content) ]	32✔
243	\| Link { target = Internal ref_; content = c; _ } ->	1,585✔
244	[ internalref ~in_source ~verbatim ref_ c ]	1,585✔
245	\| Source c ->	688✔
246	[ Inlined_code (source (inline ~verbatim:false ~in_source:true) c) ]	688✔
247	\| Math s -> [ Raw (Format.asprintf "%a" Raw.math s) ]	2✔
248	\| Raw_markup r -> raw_markup r	4✔
249	\| Entity s -> [ entity ~in_source ~verbatim s ]	260✔
250	in
251
252	let take_text (l : Inline.t) =
253	Doctree.Take.until l ~classify:(function	46,036✔
254	\| { Inline.desc = Text code; _ } -> Accum [ code ]	54,955✔
UNCOV 255	\| { desc = Entity e; _ } -> Accum [ escape_entity e ]	×
256	\| _ -> Stop_and_keep)	736✔
257	in
258	(* if in_source then block_code_txt s else if_not_empty (fun x -> Txt x) s *)
259	let rec prettify = function
260	\| { Inline.desc = Inline.Text _; _ } :: _ as l ->	46,036✔
261	let words, _, rest = take_text l in
262	txt ~in_source ~verbatim words @ prettify rest	46,036✔
263	\| o :: q -> one o @ prettify q	2,705✔
264	\| [] -> []	47,459✔
265	in
266	prettify l
267
268	let heading (h : Heading.t) =
269	let content = inline ~in_source:false ~verbatim:false h.title in	447✔
270	[ Section { label = h.label; level = h.level; content }; Break Aesthetic ]	447✔
271
272	let non_empty_block_code c =
273	let s = source (inline ~verbatim:true ~in_source:true) c in	2✔
274	match s with	2✔
UNCOV 275	\| [] -> []	×
276	\| _ :: _ as l -> [ Break Separation; Code_block l; Break Separation ]	2✔
277
278	let non_empty_code_fragment c =
279	let s = source (inline ~verbatim:false ~in_source:true) c in	3,934✔
280	match s with [] -> [] \| _ :: _ as l -> [ Code_fragment l ]	681✔
281
282	let rec block ~in_source (l : Block.t) =
283	let one (t : Block.one) =	1,166✔
284	match t.desc with	1,114✔
285	\| Inline i -> inline ~verbatim:false ~in_source:false i	146✔
286	\| Audio (_, content) \| Video (_, content) \| Image (_, content) ->	3✔
287	txt ~verbatim:false ~in_source:false [ content ]	13✔
UNCOV 288	@ if in_source then [] else [ Break Paragraph ]	×
289	\| Paragraph i ->	808✔
290	inline ~in_source:false ~verbatim:false i	808✔
291	@ if in_source then [] else [ Break Paragraph ]	340✔
292	\| List (typ, l) ->	41✔
293	[ List { typ; items = List.map (block ~in_source:false) l } ]	41✔
294	\| Table t -> table_block t	10✔
295	\| Description l ->	84✔
296	[
297	(let item i =
298	( inline ~in_source ~verbatim:false i.Description.key,	94✔
299	block ~in_source i.Description.definition )	94✔
300	in
301	Description (List.map item l));	84✔
302	]
303	\| Raw_markup r -> raw_markup r	2✔
304	\| Verbatim s -> [ Verbatim s ]	6✔
305	\| Source (_, c) -> non_empty_block_code c	2✔
306	\| Math s ->	2✔
307	[
308	Break Paragraph;
309	Raw (Format.asprintf "%a" Raw.equation s);	2✔
310	Break Paragraph;
311	]
312	in
313	Odoc_utils.List.concat_map l ~f:one
314
315	and table_block { Table.data; align } =
316	let data =	10✔
317	List.map
318	(List.map (fun (cell, cell_type) ->	10✔
319	let content = block ~in_source:false cell in	64✔
320	match cell_type with	64✔
321	\| `Header -> [ Style (`Bold, content) ]	24✔
322	\| `Data -> content))	40✔
323	data
324	in
325	[ Table { align; data } ]	10✔
326
327	let rec is_only_text l =
328	let is_text : Item.t -> _ = function	995✔
329	\| Heading _ \| Text _ -> true	149✔
330	\| Declaration _ -> false	654✔
331	\| Include { content = items; _ } -> is_only_text items.content	24✔
332	in
333	List.for_all is_text l
334
335	let rec documentedSrc (t : DocumentedSrc.t) =
336	let open DocumentedSrc in	1,733✔
337	let rec to_latex t =
338	match t with	7,730✔
339	\| [] -> []	2,514✔
340	\| Code _ :: _ ->	3,812✔
341	let take_code l =
342	Doctree.Take.until l ~classify:(function	3,812✔
343	\| Code code -> Accum code	6,528✔
344	\| _ -> Stop_and_keep)	1,404✔
345	in
346	let code, _, rest = take_code t in
347	non_empty_code_fragment code @ to_latex rest	3,812✔
348	\| Alternative (Expansion e) :: rest ->	693✔
349	(if Link.should_inline e.status e.url then to_latex e.expansion	571✔
350	else non_empty_code_fragment e.summary)	122✔
351	@ to_latex rest	693✔
352	\| Subpage subp :: rest ->	571✔
353	Indented (items subp.content.items) :: to_latex rest	571✔
354	\| (Documented _ \| Nested _) :: _ ->	24✔
355	let take_descr l =
356	Doctree.Take.until l ~classify:(function	140✔
357	\| Documented { attrs; anchor; code; doc; markers } ->	40✔
358	Accum
359	[
360	{
361	DocumentedSrc.attrs;
362	anchor;
363	code = `D code;
364	doc;
365	markers;
366	};
367	]
368	\| Nested { attrs; anchor; code; doc; markers } ->	210✔
369	Accum
370	[
371	{
372	DocumentedSrc.attrs;
373	anchor;
374	code = `N code;
375	doc;
376	markers;
377	};
378	]
379	\| _ -> Stop_and_keep)	140✔
380	in
381	let l, _, rest = take_descr t in
382	let one dsrc =	140✔
383	let content =	250✔
384	match dsrc.code with
385	\| `D code -> inline ~verbatim:false ~in_source:true code	40✔
386	\| `N n -> to_latex n	210✔
387	in
388	let doc = [ block ~in_source:true dsrc.doc ] in	250✔
389	(content @ label dsrc.anchor) :: doc	250✔
390	in
391	layout_table (List.map one l) @ to_latex rest	140✔
392	in
393	to_latex t
394
395	and items l =
396	let rec walk_items ~only_text acc (t : Item.t list) =	909✔
397	let continue_with rest elts =	3,382✔
398	walk_items ~only_text (List.rev_append elts acc) rest	2,411✔
399	in
400	match t with
401	\| [] -> List.rev acc	971✔
402	\| Text _ :: _ as t ->	169✔
403	let text, _, rest =
404	Doctree.Take.until t ~classify:(function
405	\| Item.Text text -> Accum text	215✔
406	\| _ -> Stop_and_keep)	104✔
407	in
408	let content = block ~in_source:false text in	169✔
409	let elts = content in	169✔
410	elts \|> continue_with rest
411	\| Heading h :: rest -> heading h \|> continue_with rest	447✔
412	\| Include	62✔
413	{
414	attr = _;
415	source_anchor = _;
416	anchor;
417	doc;
418	content = { summary; status = _; content };
419	}
420	:: rest ->
421	let included = items content in
422	let docs = block ~in_source:true doc in	62✔
423	let summary = source (inline ~verbatim:false ~in_source:true) summary in	62✔
424	let content = included in	62✔
425	label anchor @ docs @ summary @ content \|> continue_with rest	62✔
426	\| Declaration { Item.attr = _; source_anchor = _; anchor; content; doc }	1,733✔
427	:: rest ->
428	let content = label anchor @ documentedSrc content in	1,733✔
429	let elts =
430	match doc with
431	\| [] -> content @ [ Break Line ]	1,335✔
432	\| docs ->	398✔
433	content
434	@ [ Indented (block ~in_source:true docs); Break Separation ]	398✔
435	in
436	continue_with rest elts
437	and items l = walk_items ~only_text:(is_only_text l) [] l in	971✔
438	items l
439
440	module Doc = struct
441	let link_children ppf children =
442	let input_child ppf child =	89✔
443	Raw.input ppf child.Odoc_document.Renderer.filename	47✔
444	in
445	Fmt.list input_child ppf children
446
447	let make ~with_children url content children =
448	let filename = Link.filename url in	169✔
449	let label = Label (Link.page url) in	169✔
450	let content =
451	match content with
452	\| [] -> [ label ]	×
453	\| (Section _ as s) :: q -> s :: label :: q	169✔
UNCOV 454	\| q -> label :: q	×
455	in
456	let children_input ppf =
UNCOV 457	if with_children then link_children ppf children else ()	×
458	in
459	let content ppf = Fmt.pf ppf "@[<v>%a@,%t@]@." pp content children_input in	89✔
460	{ Odoc_document.Renderer.filename; content; children }
461	end
462
463	module Page = struct
464	let on_sub = function `Page _ -> Some 1 \| `Include _ -> None	60✔
465
466	let rec subpage ~with_children (p : Subpage.t) =
467	if Link.should_inline p.status p.content.url then []	294✔
468	else [ page ~with_children p.content ]	94✔
469
470	and subpages ~with_children subpages =
471	List.flatten @@ List.map (subpage ~with_children) subpages	169✔
472
473	and page ~with_children p =
474	let { Page.preamble; items = i; url; _ } =	169✔
475	Doctree.Labels.disambiguate_page ~enter_subpages:true p	169✔
476	and subpages = subpages ~with_children @@ Doctree.Subpages.compute p in	169✔
477	let i = Doctree.Shift.compute ~on_sub i in
478	let header = items (Doctree.PageTitle.render_title p @ preamble) in	169✔
479	let content = items i in	169✔
480	let page = Doc.make ~with_children url (header @ content) subpages in	169✔
481	page	169✔
482	end
483
484	let render ~with_children = function
485	\| Document.Page page -> [ Page.page ~with_children page ]	75✔
486	\| Source_page _ -> []	×
487
UNCOV 488	let filepath url = Link.filename ~add_ext:false url	×

ocaml / odoc / 2403

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous