Skip to content

Commit 1375d6e

Browse files
panglesdpanglesd
committed
Driver: Separate package and odoc unit types
This factors works from the various "package extractors" (from the opam switch, the dune `_build/default` directory, the voodoo way). It makes it more readable as: - The various "extractors" have less things to do, - The paths for an odoc unit are computed once, all at the same place and without bothering running the commands - Running the commands in the right order is much simpler with all args pre-computed. Also, it allows to add odoc units from outside of a package, which will be useful for adding pages outside of any package. Indexes are temporarily removed in this commit
1 parent 4c03cf3 commit 1375d6e

File tree

10 files changed

+416
-409
lines changed

10 files changed

+416
-409
lines changed

‎src/driver/compile.ml

Lines changed: 147 additions & 222 deletions
Large diffs are not rendered by default.

‎src/driver/compile.mli

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,7 @@ val compile :
66
?partial:Fpath.t ->
77
output_dir:Fpath.t ->
88
?linked_dir:Fpath.t ->
9-
Packages.set ->
9+
(* Packages.set *) Odoc_unit.t list (* Util.StringMap.t *) ->
1010
compiled list
1111
(** Use [partial] to reuse the output of a previous call to [compile]. Useful in
1212
the voodoo context.
@@ -18,8 +18,8 @@ type linked
1818

1919
val link : compiled list -> linked list
2020

21-
val index : odocl_dir:Fpath.t -> Packages.set -> unit
21+
(* val index : odocl_dir:Fpath.t -> Packages.set -> unit *)
2222

23-
val sherlodoc : html_dir:Fpath.t -> odocl_dir:Fpath.t -> Packages.set -> unit
23+
(* val sherlodoc : html_dir:Fpath.t -> odocl_dir:Fpath.t -> Packages.set -> unit *)
2424

25-
val html_generate : Fpath.t -> odocl_dir:Fpath.t -> linked list -> unit
25+
val html_generate : Fpath.t (* -> odocl_dir:Fpath.t *) -> linked list -> unit

‎src/driver/dune_style.ml

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -36,7 +36,7 @@ let of_dune_build dir =
3636
in
3737
let pkg_dir = Fpath.rem_prefix dir path |> Option.get in
3838
( pkg_dir,
39-
Packages.Lib.v ~pkg_dir
39+
Packages.Lib.v
4040
~libname_of_archive:(Util.StringMap.singleton libname libname)
4141
~pkg_name:libname ~dir:path ~cmtidir:(Some cmtidir) ))
4242
libs
@@ -53,7 +53,6 @@ let of_dune_build dir =
5353
version = "1.0";
5454
libraries = [ lib ];
5555
mlds = [];
56-
mld_odoc_dir = Fpath.v lib.Packages.lib_name;
5756
pkg_dir;
5857
other_docs = Fpath.Set.empty;
5958
} )

‎src/driver/odoc.ml

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,10 @@ open Bos
33
type id = Fpath.t
44

55
let fpath_of_id id = id
6-
let id_of_fpath id = id
6+
7+
let id_of_fpath id =
8+
id |> Fpath.normalize
9+
|> Fpath.rem_empty_seg (* If an odoc path ends with a [/] everything breaks *)
710

811
let index_filename = "index.odoc-index"
912

‎src/driver/odoc_driver.ml

Lines changed: 9 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -529,7 +529,7 @@ let run libs verbose packages_dir odoc_dir odocl_dir html_dir stats nb_workers
529529
if voodoo then
530530
match Util.StringMap.to_list all with
531531
| [ (_, p) ] ->
532-
let output_path = Fpath.(odoc_dir // p.mld_odoc_dir) in
532+
let output_path = Fpath.(odoc_dir // p.pkg_dir / "doc") in
533533
Some output_path
534534
| _ -> failwith "Error, expecting singleton library in voodoo mode"
535535
else None
@@ -538,15 +538,19 @@ let run libs verbose packages_dir odoc_dir odocl_dir html_dir stats nb_workers
538538
let () =
539539
Eio.Fiber.both
540540
(fun () ->
541+
let all =
542+
let all = Util.StringMap.bindings all |> List.map snd in
543+
Odoc_unit.of_packages ~output_dir:odoc_dir ~linked_dir:odocl_dir all
544+
in
541545
let compiled =
542546
Compile.compile ?partial ~output_dir:odoc_dir ?linked_dir:odocl_dir
543547
all
544548
in
545549
let linked = Compile.link compiled in
546-
let odocl_dir = match odocl_dir with Some l -> l | None -> odoc_dir in
547-
let () = Compile.index ~odocl_dir all in
548-
let () = Compile.sherlodoc ~html_dir ~odocl_dir all in
549-
let () = Compile.html_generate html_dir ~odocl_dir linked in
550+
(* let odocl_dir = match odocl_dir with Some l -> l | None -> odoc_dir in *)
551+
(* let () = Compile.index ~odocl_dir all in *)
552+
(* let () = Compile.sherlodoc ~html_dir ~odocl_dir all in *)
553+
let () = Compile.html_generate html_dir (* ~odocl_dir *) linked in
550554
let _ = Odoc.support_files html_dir in
551555
())
552556
(fun () -> render_stats env nb_workers)

‎src/driver/odoc_unit.ml

Lines changed: 190 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,190 @@
1+
type pkg_args = {
2+
pages : (string * Fpath.t) list;
3+
libs : (string * Fpath.t) list;
4+
}
5+
6+
type 'a unit = {
7+
parent_id : Odoc.id;
8+
odoc_dir : Fpath.t;
9+
input_file : Fpath.t;
10+
output_dir : Fpath.t;
11+
odoc_file : Fpath.t;
12+
odocl_file : Fpath.t;
13+
pkg_args : pkg_args;
14+
pkgname : string;
15+
include_dirs : Fpath.t list;
16+
kind : 'a;
17+
}
18+
19+
type intf_extra = { hidden : bool; hash : string; deps : intf unit list }
20+
and intf = [ `Intf of intf_extra ]
21+
22+
type impl = [ `Impl ]
23+
24+
type mld = [ `Mld ]
25+
26+
type t = [ impl | intf | mld ] unit
27+
28+
let of_packages ~output_dir ~linked_dir (pkgs : Packages.t list) : t list =
29+
let linked_dir =
30+
match linked_dir with None -> output_dir | Some dir -> dir
31+
in
32+
(* This isn't a hashtable, but a table of hashes! Yay! *)
33+
let hashtable =
34+
let open Packages in
35+
let h = Util.StringMap.empty in
36+
List.fold_left
37+
(fun h pkg ->
38+
List.fold_left
39+
(fun h lib ->
40+
List.fold_left
41+
(fun h mod_ ->
42+
Util.StringMap.add mod_.m_intf.mif_hash
43+
(pkg, lib.lib_name, mod_) h)
44+
h lib.modules)
45+
h pkg.libraries)
46+
h pkgs
47+
in
48+
(* This one is a hashtable *)
49+
let cache = Hashtbl.create 10 in
50+
let pkg_args : pkg_args =
51+
let pages, libs =
52+
List.fold_left
53+
(fun (pages, libs) pkg ->
54+
let page =
55+
( pkg.Packages.name,
56+
Fpath.(output_dir // pkg.Packages.pkg_dir / "doc") )
57+
in
58+
let new_libs =
59+
List.map
60+
(fun lib ->
61+
( lib.Packages.lib_name,
62+
Fpath.(
63+
output_dir // pkg.Packages.pkg_dir / "lib" / lib.lib_name)
64+
))
65+
pkg.libraries
66+
in
67+
(page :: pages, new_libs :: libs))
68+
([], []) pkgs
69+
in
70+
let libs = List.concat libs in
71+
{ pages; libs }
72+
in
73+
let rec of_intf hidden pkg libname (intf : Packages.intf) : intf unit =
74+
match Hashtbl.find_opt cache intf.mif_hash with
75+
| Some unit -> unit
76+
| None ->
77+
let open Fpath in
78+
let rel_dir = pkg.Packages.pkg_dir / "lib" / libname in
79+
let odoc_dir = output_dir // rel_dir in
80+
let parent_id = rel_dir |> Odoc.id_of_fpath in
81+
let filename = intf.mif_path |> Fpath.rem_ext |> Fpath.basename in
82+
let odoc_file = odoc_dir / (filename ^ ".odoc") in
83+
let odocl_file = linked_dir // rel_dir / (filename ^ ".odocl") in
84+
let input_file = intf.mif_path in
85+
let deps =
86+
List.filter_map
87+
(fun (_name, hash) ->
88+
match Util.StringMap.find_opt hash hashtable with
89+
| None -> None
90+
| Some (pkg, lib, mod_) ->
91+
let result = of_intf mod_.m_hidden pkg lib mod_.m_intf in
92+
Hashtbl.add cache mod_.m_intf.mif_hash result;
93+
Some result)
94+
intf.mif_deps
95+
in
96+
let include_dirs = List.map (fun u -> u.odoc_dir) deps in
97+
let kind = `Intf { hidden; hash = intf.mif_hash; deps } in
98+
{
99+
output_dir;
100+
pkgname = pkg.name;
101+
pkg_args;
102+
parent_id;
103+
odoc_dir;
104+
input_file;
105+
odoc_file;
106+
odocl_file;
107+
include_dirs;
108+
kind;
109+
}
110+
in
111+
let of_impl pkg libname (impl : Packages.impl) : impl unit option =
112+
let open Fpath in
113+
match impl.mip_src_info with
114+
| None -> None
115+
| Some _ ->
116+
let rel_dir = pkg.Packages.pkg_dir / "lib" / libname in
117+
let odoc_dir = output_dir // rel_dir in
118+
let parent_id = rel_dir |> Odoc.id_of_fpath in
119+
let filename = impl.mip_path |> Fpath.rem_ext |> Fpath.basename in
120+
let odoc_file = odoc_dir / (filename ^ ".odoc") in
121+
let odocl_file = linked_dir // rel_dir / (filename ^ ".odocl") in
122+
let input_file = impl.mip_path in
123+
let kind = `Impl in
124+
Some
125+
{
126+
output_dir;
127+
pkgname = pkg.name;
128+
parent_id;
129+
odoc_dir;
130+
input_file;
131+
odoc_file;
132+
odocl_file;
133+
pkg_args;
134+
include_dirs = [];
135+
kind;
136+
}
137+
in
138+
139+
let of_module pkg libname (m : Packages.modulety) : [ impl | intf ] unit list
140+
=
141+
let i :> [ impl | intf ] unit = of_intf m.m_hidden pkg libname m.m_intf in
142+
let m :> [ impl | intf ] unit list =
143+
Option.bind m.m_impl (of_impl pkg libname) |> Option.to_list
144+
in
145+
i :: m
146+
in
147+
let of_lib pkg (lib : Packages.libty) : [ impl | intf ] unit list =
148+
List.concat_map (of_module pkg lib.lib_name) lib.modules
149+
in
150+
let of_mld pkg (mld : Packages.mld) : mld unit list =
151+
let open Fpath in
152+
let { Packages.mld_path; mld_rel_path } = mld in
153+
let rel_dir =
154+
pkg.Packages.pkg_dir / "doc" // Fpath.parent mld_rel_path
155+
|> Fpath.normalize
156+
in
157+
let odoc_dir = output_dir // rel_dir in
158+
let filename = mld_path |> Fpath.rem_ext |> Fpath.basename in
159+
let odoc_file = odoc_dir / ("page-" ^ filename ^ ".odoc") in
160+
let odocl_file = linked_dir // rel_dir / ("page-" ^ filename ^ ".odocl") in
161+
let parent_id = rel_dir |> Odoc.id_of_fpath in
162+
let include_dirs =
163+
List.map
164+
(fun (lib : Packages.libty) ->
165+
Fpath.(output_dir // pkg.pkg_dir / "lib" / lib.lib_name))
166+
pkg.libraries
167+
in
168+
let include_dirs = odoc_dir :: include_dirs in
169+
let kind = `Mld in
170+
[
171+
{
172+
output_dir;
173+
pkgname = pkg.name;
174+
parent_id;
175+
odoc_dir;
176+
input_file = mld_path;
177+
odoc_file;
178+
odocl_file;
179+
kind;
180+
pkg_args;
181+
include_dirs;
182+
};
183+
]
184+
in
185+
let of_package (pkg : Packages.t) : t list =
186+
let lib_units :> t list list = List.map (of_lib pkg) pkg.libraries in
187+
let mld_units :> t list list = List.map (of_mld pkg) pkg.mlds in
188+
List.concat (List.rev_append lib_units mld_units)
189+
in
190+
List.concat_map of_package pkgs

‎src/driver/odoc_unit.mli

Lines changed: 29 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,29 @@
1+
type pkg_args = {
2+
pages : (string * Fpath.t) list;
3+
libs : (string * Fpath.t) list;
4+
}
5+
6+
type 'a unit = {
7+
parent_id : Odoc.id;
8+
odoc_dir : Fpath.t;
9+
input_file : Fpath.t;
10+
output_dir : Fpath.t;
11+
odoc_file : Fpath.t;
12+
odocl_file : Fpath.t;
13+
pkg_args : pkg_args;
14+
pkgname : string;
15+
include_dirs : Fpath.t list;
16+
kind : 'a;
17+
}
18+
19+
type intf_extra = { hidden : bool; hash : string; deps : intf unit list }
20+
and intf = [ `Intf of intf_extra ]
21+
22+
type impl = [ `Impl ]
23+
24+
type mld = [ `Mld ]
25+
26+
type t = [ impl | intf | mld ] unit
27+
28+
val of_packages :
29+
output_dir:Fpath.t -> linked_dir:Fpath.t option -> Packages.t list -> t list

0 commit comments

Comments
 (0)