Skip to content

Commit 7f4b195

Browse files
panglesdpanglesd
committed
Allow for empty --parent-id
Useful for the list of packages landing page
1 parent d74d713 commit 7f4b195

File tree

13 files changed

+109
-61
lines changed

13 files changed

+109
-61
lines changed

‎src/driver/landing_pages.ml

Lines changed: 8 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -43,7 +43,9 @@ let list_packages_content all =
4343
all |> List.sort (fun n1 n2 -> String.compare n1.name n2.name)
4444
in
4545
let title = "{0 List of all packages}\n" in
46-
let s_of_pkg pkg = Format.sprintf "- {{!/%s/index}%s}" pkg.name pkg.name in
46+
let s_of_pkg pkg =
47+
Format.sprintf "- {{!/__driver/%s/index}%s}" pkg.name pkg.name
48+
in
4749
let pkg_ul = sorted_packages |> List.map s_of_pkg |> String.concat "\n" in
4850
title ^ pkg_ul
4951

@@ -55,7 +57,7 @@ let of_package ~mld_dir ~odoc_dir ~odocl_dir ~output_dir pkg =
5557
let odoc_file = Fpath.(odoc_dir // rel_path / "page-index.odoc") in
5658
let odocl_file = Fpath.(odocl_dir // rel_path / "page-index.odocl") in
5759
let () = write_file input_file content in
58-
let parent_id = rel_path |> Odoc.id_of_fpath in
60+
let parent_id = rel_path |> Odoc.Id.of_fpath in
5961
let open Odoc_unit in
6062
{
6163
parent_id;
@@ -106,17 +108,17 @@ let of_package ~mld_dir ~odoc_dir ~odocl_dir ~output_dir pkg =
106108

107109
let of_packages ~mld_dir ~odoc_dir ~odocl_dir ~output_dir all =
108110
let content = list_packages_content all in
109-
let rel_path = Fpath.v "a" in
111+
let rel_path = Fpath.v "./" in
110112
let input_file = Fpath.(mld_dir // rel_path / "index.mld") in
111113
let () = write_file input_file content in
112114
let open Odoc_unit in
113-
let parent_id = rel_path |> Odoc.id_of_fpath in
115+
let parent_id = rel_path |> Odoc.Id.of_fpath in
114116
let pkgname = "__driver" in
115117
let pkg_args =
116118
{
117119
pages =
118-
(pkgname, Fpath.(odoc_dir // rel_path))
119-
:: List.map (fun pkg -> (pkg.name, Fpath.(odoc_dir / pkg.name))) all;
120+
(pkgname, Fpath.(odoc_dir // rel_path)) :: []
121+
(* List.map (fun pkg -> (pkg.name, Fpath.(odoc_dir / pkg.name))) all *);
120122
libs = [];
121123
}
122124
in

‎src/driver/odoc.ml

Lines changed: 23 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,20 @@
11
open Bos
22

3-
type id = Fpath.t
3+
module Id : sig
4+
type t
5+
val to_fpath : t -> Fpath.t
6+
val of_fpath : Fpath.t -> t
7+
val to_string : t -> string
8+
end = struct
9+
type t = Fpath.t
410

5-
let fpath_of_id id = id
11+
let to_fpath id = id
612

7-
let id_of_fpath id =
8-
id |> Fpath.normalize
9-
|> Fpath.rem_empty_seg (* If an odoc path ends with a [/] everything breaks *)
13+
let of_fpath id = id |> Fpath.normalize |> Fpath.rem_empty_seg
14+
(* If an odoc path ends with a [/] everything breaks *)
15+
16+
let to_string id = match Fpath.to_string id with "." -> "" | v -> v
17+
end
1018

1119
let index_filename = "index.odoc-index"
1220

@@ -33,13 +41,13 @@ let compile ~output_dir ~input_file:file ~includes ~parent_id =
3341
in
3442
let output_file =
3543
let _, f = Fpath.split_base file in
36-
Some Fpath.(output_dir // parent_id // set_ext "odoc" f)
44+
Some Fpath.(output_dir // Id.to_fpath parent_id // set_ext "odoc" f)
3745
in
3846
let cmd =
3947
!odoc % "compile" % Fpath.to_string file % "--output-dir" % p output_dir
4048
%% includes % "--enable-missing-root-warning"
4149
in
42-
let cmd = cmd % "--parent-id" % Fpath.to_string parent_id in
50+
let cmd = cmd % "--parent-id" % Id.to_string parent_id in
4351
let desc = Printf.sprintf "Compiling %s" (Fpath.to_string file) in
4452
let lines = Cmd_outputs.submit desc cmd output_file in
4553
Cmd_outputs.(
@@ -48,13 +56,14 @@ let compile ~output_dir ~input_file:file ~includes ~parent_id =
4856
let compile_asset ~output_dir ~name ~parent_id =
4957
let open Cmd in
5058
let output_file =
51-
Some Fpath.(output_dir // parent_id / ("asset-" ^ name ^ ".odoc"))
59+
Some
60+
Fpath.(output_dir // Id.to_fpath parent_id / ("asset-" ^ name ^ ".odoc"))
5261
in
5362
let cmd =
5463
!odoc % "compile-asset" % "--name" % name % "--output-dir" % p output_dir
5564
in
5665

57-
let cmd = cmd % "--parent-id" % Fpath.to_string parent_id in
66+
let cmd = cmd % "--parent-id" % Id.to_string parent_id in
5867
let desc = Printf.sprintf "Compiling %s" name in
5968
let lines = Cmd_outputs.submit desc cmd output_file in
6069
Cmd_outputs.(add_prefixed_output cmd compile_output name lines)
@@ -73,10 +82,12 @@ let compile_impl ~output_dir ~input_file:file ~includes ~parent_id ~source_id =
7382
let output_file =
7483
let _, f = Fpath.split_base file in
7584
Some
76-
Fpath.(output_dir // parent_id / ("impl-" ^ to_string (set_ext "odoc" f)))
85+
Fpath.(
86+
output_dir // Id.to_fpath parent_id
87+
/ ("impl-" ^ to_string (set_ext "odoc" f)))
7788
in
78-
let cmd = cmd % "--parent-id" % Fpath.to_string parent_id in
79-
let cmd = cmd % "--source-id" % Fpath.to_string source_id in
89+
let cmd = cmd % "--parent-id" % Id.to_string parent_id in
90+
let cmd = cmd % "--source-id" % Id.to_string source_id in
8091
let desc =
8192
Printf.sprintf "Compiling implementation %s" (Fpath.to_string file)
8293
in

‎src/driver/odoc.mli

Lines changed: 10 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,9 @@
1-
type id
2-
3-
val fpath_of_id : id -> Fpath.t
4-
val id_of_fpath : Fpath.t -> id
1+
module Id : sig
2+
type t
3+
val to_fpath : t -> Fpath.t
4+
val of_fpath : Fpath.t -> t
5+
val to_string : t -> string
6+
end
57

68
val index_filename : string
79

@@ -14,17 +16,17 @@ val compile_impl :
1416
output_dir:Fpath.t ->
1517
input_file:Fpath.t ->
1618
includes:Fpath.set ->
17-
parent_id:id ->
18-
source_id:id ->
19+
parent_id:Id.t ->
20+
source_id:Id.t ->
1921
unit
2022
val compile :
2123
output_dir:Fpath.t ->
2224
input_file:Fpath.t ->
2325
includes:Fpath.set ->
24-
parent_id:id ->
26+
parent_id:Id.t ->
2527
unit
2628

27-
val compile_asset : output_dir:Fpath.t -> name:string -> parent_id:id -> unit
29+
val compile_asset : output_dir:Fpath.t -> name:string -> parent_id:Id.t -> unit
2830

2931
val link :
3032
?ignore_output:bool ->

‎src/driver/odoc_driver.ml

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -584,9 +584,13 @@ let run libs verbose packages_dir odoc_dir odocl_dir html_dir stats nb_workers
584584

585585
(* List.iter *)
586586
(* (fun l -> *)
587-
(* if Astring.String.is_infix ~affix:"index.mld" l then *)
587+
(* if Astring.String.is_infix ~affix:"_odoc/./index.mld" l then *)
588588
(* Format.printf "%s\n" l) *)
589589
(* !Cmd_outputs.compile_output; *)
590+
(* List.iter *)
591+
(* (fun l -> *)
592+
(* if Astring.String.is_infix ~affix:"__driver" l then Format.printf "%s\n" l) *)
593+
(* !Cmd_outputs.link_output; *)
590594
Format.eprintf "Final stats: %a@.%!" Stats.pp_stats Stats.stats;
591595
Format.eprintf "Total time: %f@.%!" (Stats.total_time ());
592596
if stats then Stats.bench_results html_dir

‎src/driver/odoc_unit.ml

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,7 @@ type index = {
1111
}
1212

1313
type 'a unit = {
14-
parent_id : Odoc.id;
14+
parent_id : Odoc.Id.t;
1515
odoc_dir : Fpath.t;
1616
input_file : Fpath.t;
1717
output_dir : Fpath.t;
@@ -27,7 +27,7 @@ type 'a unit = {
2727
type intf_extra = { hidden : bool; hash : string; deps : intf unit list }
2828
and intf = [ `Intf of intf_extra ]
2929

30-
type impl_extra = { src_id : Odoc.id; src_path : Fpath.t }
30+
type impl_extra = { src_id : Odoc.Id.t; src_path : Fpath.t }
3131
type impl = [ `Impl of impl_extra ]
3232

3333
type mld = [ `Mld ]
@@ -96,7 +96,7 @@ let of_packages ~output_dir ~linked_dir ~index_dir (pkgs : Packages.t list) :
9696
let ( // ) = Fpath.( // ) in
9797
let ( / ) = Fpath.( / ) in
9898
let odoc_dir = output_dir // rel_dir in
99-
let parent_id = rel_dir |> Odoc.id_of_fpath in
99+
let parent_id = rel_dir |> Odoc.Id.of_fpath in
100100
let odoc_file = odoc_dir / (name ^ ".odoc") in
101101
let odocl_file = linked_dir // rel_dir / (name ^ ".odocl") in
102102
{
@@ -152,7 +152,7 @@ let of_packages ~output_dir ~linked_dir ~index_dir (pkgs : Packages.t list) :
152152
let kind =
153153
let src_name = Fpath.filename src_path in
154154
let src_id =
155-
Fpath.(pkg.pkg_dir / "src" / libname / src_name) |> Odoc.id_of_fpath
155+
Fpath.(pkg.pkg_dir / "src" / libname / src_name) |> Odoc.Id.of_fpath
156156
in
157157
`Impl { src_id; src_path }
158158
in

‎src/driver/odoc_unit.mli

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,7 @@ type index = {
1111
}
1212

1313
type 'a unit = {
14-
parent_id : Odoc.id;
14+
parent_id : Odoc.Id.t;
1515
odoc_dir : Fpath.t;
1616
input_file : Fpath.t;
1717
output_dir : Fpath.t;
@@ -27,7 +27,7 @@ type 'a unit = {
2727
type intf_extra = { hidden : bool; hash : string; deps : intf unit list }
2828
and intf = [ `Intf of intf_extra ]
2929

30-
type impl_extra = { src_id : Odoc.id; src_path : Fpath.t }
30+
type impl_extra = { src_id : Odoc.Id.t; src_path : Fpath.t }
3131
type impl = [ `Impl of impl_extra ]
3232

3333
type mld = [ `Mld ]

‎src/html/link.ml

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -36,7 +36,13 @@ module Path = struct
3636
dir @ [ file ]
3737

3838
let as_filename ~is_flat (url : Url.Path.t) =
39-
Fpath.(v @@ String.concat Fpath.dir_sep @@ for_linking ~is_flat url)
39+
let url_segs = for_linking ~is_flat url in
40+
let filename =
41+
match url_segs with
42+
| [] -> Fpath.v "./"
43+
| url_segs -> Fpath.(v @@ String.concat Fpath.dir_sep @@ url_segs)
44+
in
45+
filename
4046
end
4147

4248
type resolve = Current of Url.Path.t | Base of string

‎src/odoc/asset.ml

Lines changed: 11 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,20 @@
1+
open Or_error
2+
13
let compile ~parent_id ~name ~output_dir =
24
let open Odoc_model in
3-
let parent_id = Compile.mk_id parent_id in
5+
let parent_id =
6+
match Compile.mk_id parent_id with
7+
| Some s -> Ok s
8+
| None ->
9+
Error (`Msg "parent-id cannot be empty when compiling implementations.")
10+
in
11+
parent_id >>= fun parent_id ->
412
let id =
513
Paths.Identifier.Mk.asset_file
614
((parent_id :> Paths.Identifier.Page.t), Names.AssetName.make_std name)
715
in
816
let directory =
9-
Compile.path_of_id output_dir parent_id
17+
Compile.path_of_id output_dir (Some parent_id)
1018
|> Fpath.to_string |> Fs.Directory.of_string
1119
in
1220
let name = "asset-" ^ name ^ ".odoc" in
@@ -21,4 +29,4 @@ let compile ~parent_id ~name ~output_dir =
2129
}
2230
in
2331
let asset = Lang.Asset.{ name = id; root } in
24-
Odoc_file.save_asset output ~warnings:[] asset
32+
Ok (Odoc_file.save_asset output ~warnings:[] asset)

‎src/odoc/asset.mli

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1 +1,7 @@
1-
val compile : parent_id:string -> name:string -> output_dir:string -> unit
1+
open Or_error
2+
3+
val compile :
4+
parent_id:string ->
5+
name:string ->
6+
output_dir:string ->
7+
(unit, [> msg ]) result

‎src/odoc/bin/main.ml

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -353,7 +353,9 @@ module Compile_asset = struct
353353
& opt (some string) None
354354
& info ~docs ~docv:"PARENT" ~doc [ "parent-id" ])
355355
in
356-
Term.(const compile_asset $ parent_id $ asset_name $ output_dir)
356+
Term.(
357+
const handle_error
358+
$ (const compile_asset $ parent_id $ asset_name $ output_dir))
357359

358360
let info ~docs =
359361
let man =

0 commit comments

Comments
 (0)