jon.recoil.org
this repo has no description
1open Odoc_utils
2module HLink = Link
3open Odoc_document.Types
4open Tyxml
5module Link = HLink
6
7let html_of_doc ~config ~resolve docs =
8 let open Html in
9 let a :
10 ( [< Html_types.a_attrib ],
11 [< Html_types.span_content_fun ],
12 [> Html_types.span ] )
13 star =
14 Unsafe.node "a"
15 (* Makes it possible to use <a> inside span. Although this is not standard (see
16 https://developer.mozilla.org/en-US/docs/Web/Guide/HTML/Content_categories)
17 it is validated by the {{:https://validator.w3.org/nu/#textarea}W3C}. *)
18 in
19 (* [a] tags should not contain in other [a] tags. If this happens, browsers
20 start to be really weird. If PPX do bad things, such a situation could
21 happen. We manually avoid this situation. *)
22 let rec doc_to_html ~is_in_a doc =
23 match doc with
24 | Source_page.Plain_code s -> [ txt s ]
25 | Tagged_code (info, docs) -> (
26 let is_in_a = match info with Link _ -> true | _ -> is_in_a in
27 let children = List.concat_map (doc_to_html ~is_in_a) docs in
28 match info with
29 | Syntax tok -> [ span ~a:[ a_class [ tok ] ] children ]
30 (* Currently, we do not render links to documentation *)
31 | Link { documentation = _; implementation = None } -> children
32 | Link { documentation = _; implementation = Some anchor } ->
33 let href = Link.href ~config ~resolve anchor in
34 [ a ~a:[ a_href href ] children ]
35 | Anchor lbl -> [ span ~a:[ a_id lbl ] children ])
36 in
37 let span_content = List.concat_map (doc_to_html ~is_in_a:false) docs in
38 span ~a:[] span_content
39
40let count_lines_in_string s =
41 let n = ref 0 in
42 String.iter (function '\n' -> incr n | _ -> ()) s;
43 !n
44
45(** Traverse the doc to count the number of lines. *)
46let rec count_lines_in_span = function
47 | Source_page.Plain_code s -> count_lines_in_string s
48 | Tagged_code (_, docs) -> count_lines docs
49
50and count_lines l =
51 let rec inner l acc =
52 match l with
53 | [] -> acc
54 | hd :: tl -> inner tl (count_lines_in_span hd + acc)
55 in
56 inner l 0
57
58let rec line_numbers acc n =
59 let open Html in
60 if n < 1 then acc
61 else
62 let l = string_of_int n in
63 let anchor =
64 a
65 ~a:[ a_id ("L" ^ l); a_class [ "source_line" ]; a_href ("#L" ^ l) ]
66 [ txt l ]
67 in
68 line_numbers (anchor :: txt "\n" :: acc) (n - 1)
69
70let html_of_doc ~config ~resolve docs =
71 let open Html in
72 pre
73 ~a:[ a_class [ "source_container" ] ]
74 [
75 code
76 ~a:[ a_class [ "source_line_column" ] ]
77 (line_numbers [] (count_lines docs));
78 code
79 ~a:[ a_class [ "source_code" ] ]
80 [ html_of_doc ~config ~resolve docs ];
81 ]