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
module Toc = struct
type 'a element = { content : 'a; children : 'a t }
and 'a t = 'a element list
let rec from_list labels =
let rec aux depth acc = function
| [] -> (List.rev acc, [])
| (level, _) :: _ as labels when level < depth -> (List.rev acc, labels)
| (level, content) :: xs when level = depth ->
let children, xs = aux (succ depth) [] xs in
let entry = { content; children } in
let remaining, xs = aux depth (entry :: acc) xs in
(remaining, xs)
| labels ->
let children, xs = aux (succ depth) acc labels in
let remaining, xs = aux depth children xs in
(remaining, xs)
in
match labels with
| [] -> []
| (level, _) :: _ -> (
match labels |> aux level [] with
| labels, [] -> labels
| labels, xs -> labels @ from_list xs)
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 to_html ?(ol = false) f toc =
let ul children =
let r = String.concat "" children in
if ol then "<ol>" ^ r ^ "</ol>" else "<ul>" ^ r ^ "</ul>"
in
let li children = "<li>" ^ children ^ "</li>" in
let a = Format.asprintf "<a href=\"#%s\">%s</a>" in
let rec aux = function
| [] -> None
| xs ->
xs
|> List.map (fun { content = id, title; children } ->
let content = a id (f title) in
let children = Option.fold ~none:"" ~some:ul (aux children) in
li @@ content ^ children)
|> Option.some
in
aux toc |> Option.map ul
end