jon.recoil.org
this repo has no description
1open Odoc_utils
2open Types
3module Id = Odoc_model.Paths.Identifier
4
5type entry = {
6 url : Url.t;
7 valid_link : bool;
8 content : Inline.t;
9 toc_status : [ `Open | `Hidden ] option;
10}
11
12open Odoc_index
13
14module Toc : sig
15 type t = entry Tree.t
16
17 val of_page_hierarchy : Skeleton.t -> t
18
19 val to_block : prune:bool -> Url.Path.t -> t -> Block.t
20end = struct
21 type t = entry Tree.t
22
23 let to_block ~prune:_ (current_url : Url.Path.t) (tree : t) =
24 let block_tree_of_t (current_url : Url.Path.t) (tree : t) =
25 (* When transforming the tree, we use a filter_map to remove the nodes that
26 are irrelevant for the current url. However, we always want to keep the
27 root. So we apply the filter_map starting from the first children. *)
28 let convert_entry { url; valid_link; content; _ } =
29 let link =
30 if valid_link then
31 let target = Target.Internal (Target.Resolved url) in
32 let attr =
33 if url.page = current_url && Astring.String.equal url.anchor ""
34 then [ "current_unit" ]
35 else []
36 in
37 [ inline ~attr @@ Inline.Link { target; content; tooltip = None } ]
38 else content
39 in
40 Types.block @@ Inline link
41 in
42 let rec convert n =
43 let children =
44 match n.Tree.node with
45 | { url; valid_link = true; toc_status = None; _ }
46 when not (Url.Path.is_prefix url.Url.Anchor.page current_url) ->
47 []
48 | _ -> List.map convert n.children
49 in
50 { Tree.node = convert_entry n.node; children }
51 in
52 convert tree
53 in
54 let rec block_of_block_tree { Tree.node = name; children = content } =
55 let content =
56 match content with
57 | [] -> []
58 | _ :: _ ->
59 let content = List.map block_of_block_tree content in
60 [ block (Block.List (Block.Unordered, content)) ]
61 in
62 name :: content
63 in
64 let block_tree = block_tree_of_t current_url tree in
65 block_of_block_tree block_tree
66
67 let of_page_hierarchy ({ node = entry; children } : Entry.t Tree.t) : t =
68 let map_entry entry =
69 match entry.Entry.kind with
70 | Dir ->
71 let url = Url.from_identifier ~stop_before:false (entry.id :> Id.t) in
72 {
73 url;
74 valid_link = false;
75 content = [ inline @@ Text (Id.name entry.id) ];
76 toc_status = None;
77 }
78 | _ ->
79 let stop_before =
80 match entry.Entry.kind with
81 | ModuleType { has_expansion } | Module { has_expansion } ->
82 not has_expansion
83 | _ -> false
84 in
85 let url = Url.from_identifier ~stop_before (entry.id :> Id.t) in
86 let toc_status =
87 match entry.kind with
88 | Page { toc_status; _ } -> toc_status
89 | _ -> None
90 in
91 let content =
92 match entry.kind with
93 | Page { short_title = Some st; _ } -> Comment.link_content st
94 | Page { short_title = None; _ } ->
95 let title =
96 let open Odoc_model in
97 match Comment.find_zero_heading entry.doc with
98 | Some t -> t
99 | None ->
100 let name =
101 match entry.id.iv with
102 | `LeafPage (Some parent, name)
103 when Astring.String.equal
104 (Names.PageName.to_string name)
105 "index" ->
106 Id.name parent
107 | _ -> Id.name entry.id
108 in
109 Location_.[ at (span []) (`Word name) ]
110 in
111 Comment.link_content title
112 | _ ->
113 let name = Odoc_model.Paths.Identifier.name entry.id in
114 [ inline (Text name) ]
115 in
116 let valid_link =
117 match entry.kind with
118 | Page { toc_status = Some `Hidden; _ } -> false
119 | _ -> true
120 in
121 { url; content; toc_status; valid_link }
122 in
123 let f x =
124 match x.Entry.kind with
125 | Dir | Page _ | Module _ | Class_type _ | Class _ | ModuleType _ | Impl
126 ->
127 Some (map_entry x)
128 | _ -> None
129 in
130 let entry = map_entry entry in
131 let children = Forest.filter_map ~f children in
132 { Tree.node = entry; children }
133end
134
135type t = Toc.t list
136
137let of_index (v : Odoc_index.t) = List.map Toc.of_page_hierarchy v
138
139let to_block (sidebar : t) path =
140 let sb = List.map (Toc.to_block ~prune:true path) sidebar in
141 [ block (Block.List (Block.Unordered, sb)) ]