jon.recoil.org
this repo has no description
1open Odoc_unit
2open Packages
3
4let fpf = Format.fprintf
5
6let make_index ~dirs ~rel_dir ~libs ~pkgs ~index ~enable_warnings ~content :
7 Odoc_unit.mld Odoc_unit.t =
8 let { odoc_dir; odocl_dir; mld_dir; _ } = dirs in
9 let input_file = Fpath.(mld_dir // rel_dir / "index.mld") in
10 let odoc_file = Fpath.(odoc_dir // rel_dir / "page-index.odoc") in
11 let odocl_file = Fpath.(odocl_dir // rel_dir / "page-index.odocl") in
12 let parent_id = rel_dir |> Odoc.Id.of_fpath in
13 let pages =
14 List.map (fun pkg -> (pkg.Packages.name, Odoc_unit.doc_dir pkg)) pkgs
15 in
16 let libs =
17 List.map
18 (fun (pkg, lib) -> (lib.Packages.lib_name, Odoc_unit.lib_dir pkg lib))
19 libs
20 in
21 let pkg_args = Pkg_args.v ~pages ~libs ~includes:[] ~odoc_dir ~odocl_dir in
22 Util.with_out_to input_file (fun oc ->
23 fpf (Format.formatter_of_out_channel oc) "%t@?" content)
24 |> Result.get_ok;
25 {
26 output_dir = dirs.odoc_dir;
27 pkgname = None;
28 pkg_args;
29 parent_id;
30 input_file;
31 input_copy = None;
32 odoc_file;
33 odocl_file;
34 enable_warnings;
35 to_output = true;
36 kind = `Mld;
37 index;
38 }
39
40let module_list ppf lib =
41 let modules = List.filter (fun m -> not m.m_hidden) lib.modules in
42 match modules with
43 | [] -> fpf ppf "No module."
44 | _ :: _ ->
45 let modules =
46 List.sort (fun m m' -> String.compare m.m_name m'.m_name) modules
47 in
48 fpf ppf "{!modules:";
49 List.iter (fun m -> fpf ppf " %s" m.m_name) modules;
50 fpf ppf "}@\n"
51
52let library ~dirs ~pkg ~index lib =
53 let content ppf =
54 fpf ppf "%@toc_status hidden\n";
55 fpf ppf "%@order_category libraries\n";
56 fpf ppf "{0 Library [%s]}@\n" lib.lib_name;
57 fpf ppf "%a@\n" module_list lib
58 in
59 let rel_dir = lib_dir pkg lib in
60 let libs = [ (pkg, lib) ] in
61 make_index ~dirs ~rel_dir ~libs ~pkgs:[] ~index:(Some index) ~content
62 ~enable_warnings:false
63
64let package ~dirs ~pkg ~index =
65 let library_list ppf pkg =
66 let print_lib lib =
67 fpf ppf "{2 Library %s}@\n%a@\n" lib.lib_name module_list lib
68 in
69 let libraries =
70 List.sort
71 (fun lib lib' -> String.compare lib.lib_name lib'.lib_name)
72 pkg.libraries
73 in
74 List.iter print_lib libraries
75 in
76 let content pkg ppf =
77 fpf ppf "{0 %s}@\n@\n@\n" pkg.name;
78 List.iter
79 (fun { mld_rel_path; _ } ->
80 let page = mld_rel_path |> Fpath.rem_ext |> Fpath.to_string in
81 fpf ppf "@\n{!/%s/%s}@\n" pkg.name page)
82 pkg.mlds;
83 if not (List.is_empty pkg.libraries) then
84 fpf ppf "{1 API}@\n@\n%a@\n" library_list pkg
85 in
86 let content = content pkg in
87 let rel_dir = doc_dir pkg in
88 let libs = List.map (fun lib -> (pkg, lib)) pkg.libraries in
89 make_index ~dirs ~rel_dir ~index:(Some index) ~content ~pkgs:[ pkg ] ~libs
90 ~enable_warnings:false
91
92let src ~dirs ~pkg ~index =
93 let content ppf =
94 fpf ppf "%@order_category source\n";
95 fpf ppf
96 "{0 Sources}@\n\
97 This contains the rendered source for [%s]. Use the sidebar to navigate \
98 them."
99 pkg.name
100 in
101 let rel_dir = src_dir pkg in
102 make_index ~dirs ~pkgs:[] ~libs:[] ~rel_dir ~index:(Some index) ~content
103 ~enable_warnings:true
104
105let package_list ~dirs ~remap all =
106 let content all ppf =
107 let sorted_packages =
108 all |> List.sort (fun n1 n2 -> String.compare n1.name n2.name)
109 in
110 fpf ppf "{0 List of all packages}@\n";
111 let print_pkg pkg =
112 if pkg.selected || not remap then
113 fpf ppf "- {{!/%s/page-index}%s}@\n" pkg.name pkg.name
114 in
115 List.iter print_pkg sorted_packages
116 in
117 let content = content all in
118 let rel_dir = Fpath.v "./" in
119 make_index ~dirs ~rel_dir ~pkgs:all ~libs:[] ~index:None ~content
120 ~enable_warnings:true
121
122let content dir _pkg libs _src subdirs all_libs pfp =
123 let is_root = Fpath.to_string dir = "./" in
124 fpf pfp "{0 Directory: %a}\n\n" Fpath.pp dir;
125
126 if is_root then (
127 fpf pfp "@short_title /\n";
128 fpf pfp "@children_order ";
129 Fpath.Set.iter
130 (fun x ->
131 if Fpath.basename x <> "opam_switch" then
132 fpf pfp "%s/ " (Fpath.basename x))
133 subdirs;
134 fpf pfp "opam_switch\n%!")
135 else fpf pfp "@short_title %s\n" (Fpath.basename dir);
136
137 if Fpath.Set.cardinal subdirs > 0 then (
138 fpf pfp "{1 Subdirectories}\n";
139 Fpath.Set.iter
140 (fun subdir ->
141 fpf pfp "- {{!/%s/%apage-index}%s}\n%!" Monorepo_style.monorepo_pkg_name
142 Fpath.pp subdir (Fpath.basename subdir))
143 subdirs);
144
145 if (not is_root) && List.length libs > 0 then
146 List.iter
147 (fun (_, lib) ->
148 fpf pfp "{1 Library %s}" lib.Packages.lib_name;
149 fpf pfp "%a@\n" module_list lib)
150 libs;
151
152 if is_root then (
153 fpf pfp "{1 Libraries index}\n";
154 List.iter
155 (fun lib ->
156 fpf pfp "- Library [%s]\n" lib.Packages.lib_name;
157 fpf pfp " %a@\n" module_list lib)
158 all_libs)
159
160let make_custom dirs index_of (pkg : Packages.t) :
161 Odoc_unit.mld Odoc_unit.t list =
162 let pkgs = [ pkg ] in
163 let pkg_dirs =
164 List.fold_right
165 (fun pkg dirs ->
166 Fpath.Map.add (Fpath.to_dir_path pkg.Packages.pkg_dir) pkg dirs)
167 pkgs Fpath.Map.empty
168 in
169 let lib_dirs =
170 List.fold_right
171 (fun pkg dirs ->
172 let libs = pkg.libraries in
173 List.fold_left
174 (fun dirs lib ->
175 Fpath.Map.add
176 (Fpath.to_dir_path (Odoc_unit.lib_dir pkg lib))
177 (pkg, lib) dirs)
178 dirs libs)
179 pkgs Fpath.Map.empty
180 in
181 let src_dirs =
182 List.fold_right
183 (fun pkg dirs ->
184 let libs = pkg.libraries in
185 let x =
186 List.fold_right
187 (fun lib dirs ->
188 if
189 List.exists
190 (fun m ->
191 match m.Packages.m_impl with
192 | Some { mip_src_info = Some _; _ } -> true
193 | _ -> false)
194 lib.modules
195 then
196 Fpath.Map.add
197 (Fpath.to_dir_path (Odoc_unit.src_lib_dir pkg lib))
198 (pkg, lib) dirs
199 else dirs)
200 libs dirs
201 in
202 x)
203 pkgs Fpath.Map.empty
204 in
205 let pkg_src_dirs =
206 List.fold_left
207 (fun acc pkg ->
208 Fpath.Map.add (Odoc_unit.src_dir pkg |> Fpath.to_dir_path) pkg acc)
209 Fpath.Map.empty pkgs
210 in
211 let all_dirs =
212 Fpath.Set.union (Fpath.Map.dom pkg_dirs)
213 (Fpath.Set.union (Fpath.Map.dom lib_dirs) (Fpath.Map.dom src_dirs))
214 in
215 let rec all_parents path =
216 let parent, _ = Fpath.split_base path in
217 if
218 Fpath.compare parent (Fpath.v "./") = 0
219 || Fpath.compare parent (Fpath.v "/") = 0
220 then [ path ]
221 else path :: all_parents parent
222 in
223 let all_dirs =
224 Fpath.Set.fold
225 (fun p acc ->
226 let parents = all_parents p in
227 List.fold_right Fpath.Set.add parents acc)
228 all_dirs all_dirs
229 in
230
231 let all_indexes =
232 List.fold_right
233 (fun pkg acc ->
234 let mlds = pkg.Packages.mlds in
235 let indexes =
236 List.filter
237 (fun mld -> Fpath.basename mld.mld_rel_path = "index.mld")
238 mlds
239 in
240 let index_paths =
241 List.map
242 (fun mld -> Fpath.(pkg.pkg_dir // mld.mld_rel_path |> parent))
243 indexes
244 |> Fpath.Set.of_list
245 in
246 Fpath.Set.union acc index_paths)
247 pkgs Fpath.Set.empty
248 in
249
250 Fpath.Set.fold
251 (fun p acc ->
252 if Fpath.Set.mem p all_indexes then (
253 Logs.debug (fun m -> m "Skipping predefined index.mld: %a" Fpath.pp p);
254 acc)
255 else
256 let libs =
257 let is_root = Fpath.to_string p = "./" in
258 Fpath.Map.fold
259 (fun p' lib libs -> if p = p' || is_root then lib :: libs else libs)
260 lib_dirs []
261 in
262 let src = Fpath.Map.find_opt p src_dirs in
263 let pkg_src = Fpath.Map.find_opt p pkg_src_dirs in
264 let subdirs =
265 Fpath.Set.filter (fun p' -> Fpath.parent p' = p) all_dirs
266 in
267 Logs.debug (fun x ->
268 x "dir: %a pkg: %a lib: %a src: %a pkg_src: %a subdirs: %a" Fpath.pp
269 p Fmt.string pkg.Packages.name (Fmt.Dump.list Fmt.string)
270 (List.map (fun (_, p) -> p.Packages.lib_name) libs)
271 (Fmt.Dump.option Fmt.string)
272 (Option.map (fun (_, p) -> p.Packages.lib_name) src)
273 (Fmt.Dump.option Fmt.string)
274 (Option.map (fun p -> p.Packages.name) pkg_src)
275 (Fmt.Dump.list Fpath.pp)
276 (Fpath.Set.elements subdirs));
277 let index = Some (index_of pkg) in
278 let pkgs = pkgs in
279 let all_libs = pkg.libraries in
280 Logs.debug (fun m ->
281 m "pkgs: %a"
282 Fmt.Dump.(list string)
283 (List.map (fun p -> p.Packages.name) pkgs));
284 let idx =
285 make_index ~dirs ~rel_dir:p ~libs ~pkgs
286 ~content:(content p pkg libs src subdirs all_libs)
287 ~index ~enable_warnings:false
288 in
289 idx :: acc)
290 all_dirs []