jon.recoil.org
this repo has no description
1open Odoc_unit
2
3type indices_style =
4 | Voodoo
5 | Normal of { toplevel_content : string option }
6 | Automatic
7
8let packages ~dirs ~extra_paths ~remap ~indices_style (pkgs : Packages.t list) :
9 any list =
10 let { odoc_dir; odocl_dir; index_dir; mld_dir = _ } = dirs in
11
12 let extra_libs_paths = extra_paths.Voodoo.libs in
13 let extra_libs_of_pkg = extra_paths.Voodoo.libs_of_pkg in
14 let extra_pkg_paths = extra_paths.Voodoo.pkgs in
15
16 let lib_dirs =
17 let open Packages in
18 let lds = extra_libs_paths in
19 List.fold_left
20 (fun lds pkg ->
21 List.fold_left
22 (fun lds lib ->
23 let lib_dir = lib_dir pkg lib in
24 let lds' = Util.StringMap.add lib.lib_name lib_dir lds in
25 lds')
26 lds pkg.libraries)
27 lds pkgs
28 in
29 let pkg_paths =
30 List.fold_left
31 (fun acc pkg -> Util.StringMap.add pkg.Packages.name (doc_dir pkg) acc)
32 extra_pkg_paths pkgs
33 in
34
35 let libs_of_pkg =
36 let libs_of_pkg pkg =
37 List.map (fun lib -> lib.Packages.lib_name) pkg.Packages.libraries
38 in
39 List.fold_left
40 (fun acc pkg ->
41 Util.StringMap.add pkg.Packages.name (libs_of_pkg pkg) acc)
42 extra_libs_of_pkg pkgs
43 in
44
45 let dash_p pkgname path = (pkgname, path) in
46
47 let dash_l lib_name =
48 match Util.StringMap.find_opt lib_name lib_dirs with
49 | Some dir -> [ (lib_name, dir) ]
50 | None ->
51 Logs.debug (fun m -> m "Library %s not found" lib_name);
52 []
53 in
54 let base_args pkg lib_deps : Pkg_args.t =
55 let own_page = dash_p pkg.Packages.name (doc_dir pkg) in
56 let includes =
57 List.concat_map dash_l (Util.StringSet.to_list lib_deps) |> List.map snd
58 in
59 let libs =
60 List.fold_left
61 (fun acc lib -> Util.StringSet.add lib.Packages.lib_name acc)
62 lib_deps pkg.Packages.libraries
63 in
64 let libs = List.concat_map dash_l (Util.StringSet.to_list libs) in
65 Pkg_args.v ~pages:[ own_page ] ~libs ~includes ~odoc_dir ~odocl_dir
66 in
67 let args_of_config config : Pkg_args.t =
68 let { Global_config.deps = { packages; libraries } } = config in
69 let pages_rel =
70 List.filter_map
71 (fun pkgname ->
72 match Util.StringMap.find_opt pkgname pkg_paths with
73 | None ->
74 Logs.debug (fun m -> m "Package '%s' not found" pkgname);
75 None
76 | Some path -> Some (dash_p pkgname path))
77 packages
78 in
79 (* Add all liraries from added packages *)
80 let libraries_from_pkgs =
81 List.filter_map
82 (fun pkgname -> Util.StringMap.find_opt pkgname libs_of_pkg)
83 packages
84 in
85 let libraries = List.concat @@ (libraries :: libraries_from_pkgs) in
86 let libs_rel = List.concat_map dash_l libraries in
87 Pkg_args.v ~pages:pages_rel ~libs:libs_rel ~includes:[] ~odoc_dir ~odocl_dir
88 in
89 let args_of =
90 let cache = Hashtbl.create 10 in
91 fun pkg lib_deps : Pkg_args.t ->
92 match Hashtbl.find_opt cache (pkg, lib_deps) with
93 | Some res -> res
94 | None ->
95 let result =
96 Pkg_args.combine (base_args pkg lib_deps)
97 (args_of_config pkg.Packages.config)
98 in
99 Hashtbl.add cache (pkg, lib_deps) result;
100 result
101 in
102
103 let index_of pkg =
104 let roots = [ Fpath.( // ) odocl_dir (doc_dir pkg) ] in
105 let output_file = Fpath.(index_dir / pkg.name / Odoc.index_filename) in
106 let pkg_dir = doc_dir pkg in
107 let sidebar =
108 let output_file = Fpath.(index_dir / pkg.name / Odoc.sidebar_filename) in
109 { output_file; json = false; pkg_dir }
110 in
111 {
112 roots;
113 output_file;
114 json = false;
115 search_dir = doc_dir pkg;
116 sidebar = Some sidebar;
117 }
118 in
119
120 let make_unit ~name ~kind ~rel_dir ~input_file ~pkg ~lib_deps ~enable_warnings
121 ~to_output ~stash_input : _ t =
122 let to_output = to_output || not remap in
123 (* If we haven't got active remapping, we output everything *)
124 let ( // ) = Fpath.( // ) in
125 let ( / ) = Fpath.( / ) in
126 let pkg_args = args_of pkg lib_deps in
127 let parent_id = rel_dir |> Odoc.Id.of_fpath in
128 let odoc_file =
129 odoc_dir // rel_dir / (String.uncapitalize_ascii name ^ ".odoc")
130 in
131 (* odoc will uncapitalise the output filename *)
132 let odocl_file =
133 odocl_dir // rel_dir / (String.uncapitalize_ascii name ^ ".odocl")
134 in
135 let input_copy =
136 if stash_input then
137 Some (odoc_dir // rel_dir / (String.uncapitalize_ascii name ^ ".cmti"))
138 else None
139 in
140 {
141 output_dir = odoc_dir;
142 pkgname = Some pkg.Packages.name;
143 pkg_args;
144 parent_id;
145 input_file;
146 input_copy;
147 odoc_file;
148 odocl_file;
149 kind;
150 to_output;
151 enable_warnings;
152 index = Some (index_of pkg);
153 }
154 in
155
156 let of_intf hidden pkg (lib : Packages.libty) lib_deps (intf : Packages.intf)
157 : intf t =
158 let rel_dir = lib_dir pkg lib in
159 let kind =
160 let deps = intf.mif_deps in
161 let kind = `Intf { hidden; hash = intf.mif_hash; deps } in
162 kind
163 in
164 let name = intf.mif_path |> Fpath.rem_ext |> Fpath.basename in
165 let stash_input = lib.archive_name = None in
166 make_unit ~name ~kind ~rel_dir ~input_file:intf.mif_path ~pkg ~lib_deps
167 ~enable_warnings:pkg.selected ~to_output:pkg.selected ~stash_input
168 in
169 let of_impl pkg lib lib_deps (impl : Packages.impl) : impl t option =
170 match impl.mip_src_info with
171 | None -> None
172 | Some { src_path } ->
173 let rel_dir = lib_dir pkg lib in
174 let kind =
175 let src_name = Fpath.filename src_path in
176 let src_id =
177 Fpath.(src_lib_dir pkg lib / src_name) |> Odoc.Id.of_fpath
178 in
179 `Impl { src_id; src_path }
180 in
181 let name =
182 impl.mip_path |> Fpath.rem_ext |> Fpath.basename
183 |> String.uncapitalize_ascii |> ( ^ ) "impl-"
184 in
185 let unit =
186 make_unit ~name ~kind ~rel_dir ~input_file:impl.mip_path ~pkg
187 ~lib_deps ~enable_warnings:false ~to_output:pkg.selected
188 ~stash_input:false
189 in
190 Some unit
191 in
192
193 let of_module pkg (lib : Packages.libty) lib_deps (m : Packages.modulety) :
194 any list =
195 let i :> any = of_intf m.m_hidden pkg lib lib_deps m.m_intf in
196 let m :> any list =
197 Option.bind m.m_impl (of_impl pkg lib lib_deps) |> Option.to_list
198 in
199 i :: m
200 in
201 let of_lib pkg (lib : Packages.libty) =
202 let lib_deps = Util.StringSet.add lib.lib_name lib.lib_deps in
203 let index = index_of pkg in
204 let units = List.concat_map (of_module pkg lib lib_deps) lib.modules in
205 if remap && not pkg.selected then units
206 else
207 let landing_page :> any = Landing_pages.library ~dirs ~pkg ~index lib in
208 landing_page :: units
209 in
210 let of_mld pkg (mld : Packages.mld) : mld t list =
211 let open Fpath in
212 let { Packages.mld_path; mld_rel_path } = mld in
213 let rel_dir = doc_dir pkg // Fpath.parent mld_rel_path |> Fpath.normalize in
214 let kind = `Mld in
215 let name = mld_path |> Fpath.rem_ext |> Fpath.basename |> ( ^ ) "page-" in
216 let lib_deps =
217 pkg.libraries
218 |> List.map (fun lib -> lib.Packages.lib_name)
219 |> Util.StringSet.of_list
220 in
221 let unit =
222 make_unit ~name ~kind ~rel_dir ~input_file:mld_path ~pkg ~lib_deps
223 ~enable_warnings:pkg.selected ~to_output:pkg.selected ~stash_input:false
224 in
225 [ unit ]
226 in
227 let of_md pkg (md : Packages.md) : md t list =
228 let ext = Fpath.get_ext md.md_path in
229 match ext with
230 | ".md" ->
231 let open Fpath in
232 let { Packages.md_path; md_rel_path } = md in
233 let rel_dir =
234 doc_dir pkg // Fpath.parent md_rel_path |> Fpath.normalize
235 in
236 let kind = `Md in
237 let name =
238 md_path |> Fpath.rem_ext |> Fpath.basename |> ( ^ ) "page-"
239 in
240 let lib_deps = Util.StringSet.empty in
241 let unit =
242 make_unit ~name ~kind ~rel_dir ~input_file:md_path ~pkg ~lib_deps
243 ~enable_warnings:pkg.selected ~to_output:pkg.selected
244 ~stash_input:false
245 in
246 [ unit ]
247 | _ ->
248 Logs.debug (fun m ->
249 m "Skipping non-markdown doc file %a" Fpath.pp md.md_path);
250 []
251 in
252 let of_asset pkg (asset : Packages.asset) : asset t list =
253 let open Fpath in
254 let { Packages.asset_path; asset_rel_path } = asset in
255 let rel_dir =
256 doc_dir pkg // Fpath.parent asset_rel_path |> Fpath.normalize
257 in
258 let kind = `Asset in
259 let unit =
260 let name = asset_path |> Fpath.basename |> ( ^ ) "asset-" in
261 make_unit ~name ~kind ~rel_dir ~input_file:asset_path ~pkg
262 ~lib_deps:Util.StringSet.empty ~enable_warnings:false ~to_output:true
263 ~stash_input:false
264 in
265 [ unit ]
266 in
267
268 let of_package (pkg : Packages.t) : any list =
269 let lib_units :> any list list = List.map (of_lib pkg) pkg.libraries in
270 let mld_units :> any list list = List.map (of_mld pkg) pkg.mlds in
271 let asset_units :> any list list = List.map (of_asset pkg) pkg.assets in
272 let md_units :> any list list = List.map (of_md pkg) pkg.other_docs in
273 let pkg_index () :> any list =
274 let has_index_page =
275 List.exists
276 (fun mld ->
277 Fpath.equal
278 (Fpath.normalize mld.Packages.mld_rel_path)
279 (Fpath.normalize (Fpath.v "./index.mld")))
280 pkg.mlds
281 in
282 if has_index_page || (remap && not pkg.selected) then []
283 else
284 let index = index_of pkg in
285 [ Landing_pages.package ~dirs ~pkg ~index ]
286 in
287 let src_index () :> any list =
288 if remap && not pkg.selected then []
289 else if
290 (* Some library has a module which has an implementation which has a source *)
291 List.exists
292 (fun lib ->
293 List.exists
294 (fun m ->
295 match m.Packages.m_impl with
296 | Some { mip_src_info = Some _; _ } -> true
297 | _ -> false)
298 lib.Packages.modules)
299 pkg.libraries
300 then
301 let index = index_of pkg in
302 [ Landing_pages.src ~dirs ~pkg ~index ]
303 else []
304 in
305 let std_units = mld_units @ asset_units @ md_units @ lib_units in
306 match indices_style with
307 | Automatic when pkg.name = Monorepo_style.monorepo_pkg_name ->
308 let others :> any list =
309 Landing_pages.make_custom dirs index_of
310 (List.find
311 (fun p -> p.Packages.name = Monorepo_style.monorepo_pkg_name)
312 pkgs)
313 in
314 others @ List.concat std_units
315 | Normal _ | Voodoo | Automatic ->
316 List.concat (pkg_index () :: src_index () :: std_units)
317 in
318 match indices_style with
319 | Normal { toplevel_content = None } ->
320 let gen_indices :> any = Landing_pages.package_list ~dirs ~remap pkgs in
321 gen_indices :: List.concat_map of_package pkgs
322 | Normal { toplevel_content = Some content } ->
323 let content ppf = Format.fprintf ppf "%s" content in
324 let libs =
325 List.concat_map
326 (fun pkg -> List.map (fun lib -> (pkg, lib)) pkg.Packages.libraries)
327 pkgs
328 in
329 let index :> any =
330 Landing_pages.make_index ~dirs
331 ~rel_dir:Fpath.(v "./")
332 ~libs ~pkgs ~enable_warnings:true ~content ~index:None
333 in
334 index :: List.concat_map of_package pkgs
335 | Voodoo | Automatic -> List.concat_map of_package pkgs