1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
module Toc = struct
type 'a element = { content : 'a; children : 'a t }
and 'a t = 'a element list
let from_list labels =
let rec aux depth = function
| [] -> ([], [])
| (level, content) :: xs when level < depth -> ([], (level, content) :: xs)
| (level, content) :: xs when level = depth ->
let children, rest = aux (depth + 1) xs in
let node = { content; children } in
let siblings, rest = aux depth rest in
(node :: siblings, rest)
| (_level, _) :: _ as xs -> aux (depth + 1) xs
in
let rec loop labels =
match labels with
| [] -> []
| (level, _) :: _ ->
let block, rest = aux level labels in
block @ loop rest
in
loop labels
let to_labelled_list toc =
let rec aux current_index elements =
List.mapi
(fun i { content; children } ->
let new_index = current_index @ [ i + 1 ] in
(new_index, content) :: aux new_index children)
elements
|> List.flatten
in
aux [] toc
let traverse ~on_list ~on_item:li ~on_link toc =
let rec aux = function
| [] -> None
| xs ->
xs
|> List.map (fun { content = id, title; children } ->
let content = on_link ~id ~title in
let children =
Option.fold ~none:"" ~some:on_list (aux children)
in
li @@ content ^ children)
|> Option.some
in
aux toc |> Option.map on_list
let to_html ?(ol = false) f toc =
let ul x = if ol then "<ol>" ^ x ^ "</ol>" else "<ul>" ^ x ^ "</ul>" in
traverse
~on_list:(fun x ->
let r = String.concat "" x in
ul r)
~on_item:(fun x -> "<li>" ^ x ^ "</li>")
~on_link:(fun ~id ~title ->
Format.asprintf {|<a href="#%s" data-toc-target="%s">%s</a>|} id id
(f title))
toc
end