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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
open Odoc_utils
open Types
module Id = Odoc_model.Paths.Identifier
type entry = {
url : Url.t;
valid_link : bool;
content : Inline.t;
toc_status : [ `Open | `Hidden ] option;
}
open Odoc_index
module Toc : sig
type t = entry Tree.t
val of_page_hierarchy : Skeleton.t -> t
val to_block : prune:bool -> Url.Path.t -> t -> Block.t
end = struct
type t = entry Tree.t
let to_block ~prune:_ (current_url : Url.Path.t) (tree : t) =
let block_tree_of_t (current_url : Url.Path.t) (tree : t) =
let convert_entry { url; valid_link; content; _ } =
let link =
if valid_link then
let target = Target.Internal (Target.Resolved url) in
let attr =
if url.page = current_url && Astring.String.equal url.anchor ""
then [ "current_unit" ]
else []
in
[ inline ~attr @@ Inline.Link { target; content; tooltip = None } ]
else content
in
Types.block @@ Inline link
in
let rec convert n =
let children =
match n.Tree.node with
| { url; valid_link = true; toc_status = None; _ }
when not (Url.Path.is_prefix url.Url.Anchor.page current_url) ->
[]
| _ -> List.map convert n.children
in
{ Tree.node = convert_entry n.node; children }
in
convert tree
in
let rec block_of_block_tree { Tree.node = name; children = content } =
let content =
match content with
| [] -> []
| _ :: _ ->
let content = List.map block_of_block_tree content in
[ block (Block.List (Block.Unordered, content)) ]
in
name :: content
in
let block_tree = block_tree_of_t current_url tree in
block_of_block_tree block_tree
let of_page_hierarchy ({ node = entry; children } : Entry.t Tree.t) : t =
let map_entry entry =
match entry.Entry.kind with
| Dir ->
let url = Url.from_identifier ~stop_before:false (entry.id :> Id.t) in
{
url;
valid_link = false;
content = [ inline @@ Text (Id.name entry.id) ];
toc_status = None;
}
| _ ->
let stop_before =
match entry.Entry.kind with
| ModuleType { has_expansion } | Module { has_expansion } ->
not has_expansion
| _ -> false
in
let url = Url.from_identifier ~stop_before (entry.id :> Id.t) in
let toc_status =
match entry.kind with
| Page { toc_status; _ } -> toc_status
| _ -> None
in
let content =
match entry.kind with
| Page { short_title = Some st; _ } -> Comment.link_content st
| Page { short_title = None; _ } ->
let title =
let open Odoc_model in
match Comment.find_zero_heading entry.doc with
| Some t -> t
| None ->
let name =
match entry.id.iv with
| `LeafPage (Some parent, name)
when Astring.String.equal
(Names.PageName.to_string name)
"index" ->
Id.name parent
| _ -> Id.name entry.id
in
Location_.[ at (span []) (`Word name) ]
in
Comment.link_content title
| _ ->
let name = Odoc_model.Paths.Identifier.name entry.id in
[ inline (Text name) ]
in
let valid_link =
match entry.kind with
| Page { toc_status = Some `Hidden; _ } -> false
| _ -> true
in
{ url; content; toc_status; valid_link }
in
let f x =
match x.Entry.kind with
| Dir | Page _ | Module _ | Class_type _ | Class _ | ModuleType _ | Impl
->
Some (map_entry x)
| _ -> None
in
let entry = map_entry entry in
let children = Forest.filter_map ~f children in
{ Tree.node = entry; children }
end
type t = Toc.t list
let of_index (v : Odoc_index.t) = List.map Toc.of_page_hierarchy v
let to_block ( : t) path =
let sb = List.map (Toc.to_block ~prune:true path) sidebar in
[ block (Block.List (Block.Unordered, sb)) ]