this repo has no description
WIP
authored by
Paul-Elliot
and committed by
+6
-7
src/driver/cmd_outputs.ml
+6
-7
src/driver/cmd_outputs.ml
···
5
5
| `Count_occurrences
6
6
| `Generate
7
7
| `Index
8
-
| `Source_tree
9
8
| `Sherlodoc
10
9
| `Classify ]
11
10
12
-
let outputs : (log_dest * [ `Out | `Err ] * string * string) list ref = ref []
11
+
type log_line = { log_dest : log_dest; prefix : string; run : Run.t }
12
+
13
+
let outputs : log_line list ref = ref []
13
14
14
-
let maybe_log log_dest r =
15
+
let maybe_log log_dest run =
15
16
match log_dest with
16
-
| Some (dest, prefix) ->
17
-
let add ty s = outputs := !outputs @ [ (dest, ty, prefix, s) ] in
18
-
add `Out r.Run.output;
19
-
add `Err r.Run.errors
17
+
| Some (log_dest, prefix) ->
18
+
outputs := !outputs @ [ { log_dest; run; prefix } ]
20
19
| None -> ()
21
20
22
21
let submit log_dest desc cmd output_file =
+7
src/driver/common_args.ml
+7
src/driver/common_args.ml
···
56
56
let doc = "Remap paths in non-selected packages to ocaml.org" in
57
57
Arg.(value & flag & info [ "remap" ] ~doc)
58
58
59
+
let index_grep =
60
+
let doc = "Show compile-index commands containing the string" in
61
+
Arg.(value & opt (some string) None & info [ "index-grep" ] ~doc)
62
+
59
63
type t = {
60
64
verbose : bool;
61
65
odoc_dir : Fpath.t;
···
70
74
link_grep : string option;
71
75
generate_grep : string option;
72
76
remap : bool;
77
+
index_grep : string option;
73
78
}
74
79
75
80
let term =
···
88
93
and+ compile_grep = compile_grep
89
94
and+ link_grep = link_grep
90
95
and+ generate_grep = generate_grep
96
+
and+ index_grep = index_grep
91
97
and+ remap = remap in
92
98
{
93
99
verbose;
···
103
109
link_grep;
104
110
generate_grep;
105
111
remap;
112
+
index_grep;
106
113
}
+2
-5
src/driver/compile.ml
+2
-5
src/driver/compile.ml
···
269
269
let compile_index : Odoc_unit.index -> _ =
270
270
fun index ->
271
271
let compile_index_one
272
-
({ pkg_args; output_file; json; search_dir = _; sidebar } as index :
272
+
({ roots; output_file; json; search_dir = _; sidebar } as index :
273
273
Odoc_unit.index) =
274
-
let libs_linked = Odoc_unit.Pkg_args.linked_libs pkg_args in
275
-
let pages_linked = Odoc_unit.Pkg_args.linked_pages pkg_args in
276
274
let () =
277
-
Odoc.compile_index ~json ~occurrence_file ~output_file ~libs:libs_linked
278
-
~docs:pages_linked ()
275
+
Odoc.compile_index ~json ~occurrence_file ~output_file ~roots ()
279
276
in
280
277
let sidebar =
281
278
match sidebar with
+1
-1
src/driver/landing_pages.ml
+1
-1
src/driver/landing_pages.ml
···
25
25
26
26
let library ~dirs ~pkg ~index lib =
27
27
let content ppf =
28
-
Format.fprintf ppf "{0 Library %s}@\n" lib.Packages.lib_name;
28
+
Format.fprintf ppf "{0 Library [%s]}@\n" lib.Packages.lib_name;
29
29
let print_module m =
30
30
if not m.Packages.m_hidden then
31
31
Format.fprintf ppf "- {!%s}@\n" m.Packages.m_name
+5
-17
src/driver/odoc.ml
+5
-17
src/driver/odoc.ml
···
159
159
ignore @@ Cmd_outputs.submit log desc cmd (Some output_file)
160
160
161
161
let compile_index ?(ignore_output = false) ~output_file ?occurrence_file ~json
162
-
~docs ~libs () =
163
-
let docs = doc_args docs in
164
-
let libs = lib_args libs in
162
+
~roots () =
163
+
let roots =
164
+
List.fold_left (fun c r -> Cmd.(c % "--root" % p r)) Cmd.empty roots
165
+
in
165
166
let json = if json then Cmd.v "--json" else Cmd.empty in
166
167
let occ =
167
168
match occurrence_file with
···
170
171
in
171
172
let cmd =
172
173
Cmd.(
173
-
!odoc % "compile-index" %% json %% v "-o" % p output_file %% docs %% libs
174
-
%% occ)
174
+
!odoc % "compile-index" %% json %% v "-o" % p output_file %% roots %% occ)
175
175
in
176
176
let desc =
177
177
Printf.sprintf "Generating index for %s" (Fpath.to_string output_file)
···
267
267
let cmd = !odoc % "count-occurrences" %% input %% output_c in
268
268
let desc = "Counting occurrences" in
269
269
let log = Some (`Count_occurrences, Fpath.to_string output) in
270
-
ignore @@ Cmd_outputs.submit log desc cmd None
271
-
272
-
let source_tree ?(ignore_output = false) ~parent ~output file =
273
-
let open Cmd in
274
-
let parent = v "--parent" % ("page-\"" ^ parent ^ "\"") in
275
-
let cmd =
276
-
!odoc % "source-tree" % "-I" % "." %% parent % "-o" % p output % p file
277
-
in
278
-
let desc = Printf.sprintf "Source tree for %s" (Fpath.to_string file) in
279
-
let log =
280
-
if ignore_output then None else Some (`Source_tree, Fpath.to_string file)
281
-
in
282
270
ignore @@ Cmd_outputs.submit log desc cmd None
283
271
284
272
let classify dirs =
+1
-4
src/driver/odoc.mli
+1
-4
src/driver/odoc.mli
···
46
46
output_file:Fpath.t ->
47
47
?occurrence_file:Fpath.t ->
48
48
json:bool ->
49
-
docs:(string * Fpath.t) list ->
50
-
libs:(string * Fpath.t) list ->
49
+
roots:Fpath.t list ->
51
50
unit ->
52
51
unit
53
52
···
91
90
val support_files : Fpath.t -> string list
92
91
93
92
val count_occurrences : input:Fpath.t list -> output:Fpath.t -> unit
94
-
val source_tree :
95
-
?ignore_output:bool -> parent:string -> output:Fpath.t -> Fpath.t -> unit
+21
-13
src/driver/odoc_driver.ml
+21
-13
src/driver/odoc_driver.ml
···
134
134
link_grep;
135
135
generate_grep;
136
136
remap;
137
+
index_grep;
137
138
} =
138
139
Option.iter (fun odoc_bin -> Odoc.odoc := Bos.Cmd.v odoc_bin) odoc_bin;
139
140
let _ = Voodoo.find_universe_and_version "foo" in
···
249
250
let grep_log ty s =
250
251
let open Astring in
251
252
let do_ affix =
252
-
let grep (dst, _err, prefix, content) =
253
-
if dst = ty then
254
-
let lines = String.cuts ~sep:"\n" content in
255
-
List.iter
256
-
(fun l ->
257
-
if String.is_infix ~affix l then Format.printf "%s: %s\n" prefix l)
258
-
lines
253
+
let grep { Cmd_outputs.log_dest; prefix; run } =
254
+
if log_dest = ty then
255
+
let l = run.Run.cmd |> String.concat ~sep:" " in
256
+
if String.is_infix ~affix l then Format.printf "%s: %s\n" prefix l
259
257
in
260
258
List.iter grep !Cmd_outputs.outputs
261
259
in
262
260
Option.iter do_ s
263
261
in
262
+
(* Grep log compile and compile_src commands *)
264
263
grep_log `Compile compile_grep;
264
+
grep_log `Compile_src compile_grep;
265
+
(* Grep log link commands *)
265
266
grep_log `Link link_grep;
267
+
(* Grep log generate commands *)
266
268
grep_log `Generate generate_grep;
269
+
(* Grep log index and co commands *)
270
+
grep_log `Count_occurrences index_grep;
271
+
grep_log `Count_occurrences index_grep;
272
+
grep_log `Index (* index_grep *) (Some "");
267
273
268
274
List.iter
269
-
(fun (dst, _err, prefix, content) ->
270
-
match dst with
275
+
(fun { Cmd_outputs.log_dest; prefix; run } ->
276
+
match log_dest with
271
277
| `Link ->
272
-
if String.length content = 0 then ()
273
-
else
274
-
let lines = String.split_on_char '\n' content in
275
-
List.iter (fun l -> Format.printf "%s: %s\n" prefix l) lines
278
+
[ run.Run.output; run.Run.errors ]
279
+
|> List.iter @@ fun content ->
280
+
if String.length content = 0 then ()
281
+
else
282
+
let lines = String.split_on_char '\n' content in
283
+
List.iter (fun l -> Format.printf "%s: %s\n" prefix l) lines
276
284
| _ -> ())
277
285
!Cmd_outputs.outputs;
278
286
+4
-3
src/driver/odoc_unit.ml
+4
-3
src/driver/odoc_unit.ml
···
39
39
type sidebar = { output_file : Fpath.t; json : bool }
40
40
41
41
type index = {
42
-
pkg_args : Pkg_args.t;
42
+
roots : Fpath.t list;
43
43
output_file : Fpath.t;
44
44
json : bool;
45
45
search_dir : Fpath.t;
···
48
48
49
49
let pp_index fmt x =
50
50
Format.fprintf fmt
51
-
"@[<hov>pkg_args: %a@;output_file: %a@;json: %b@;search_dir: %a@]"
52
-
Pkg_args.pp x.pkg_args Fpath.pp x.output_file x.json Fpath.pp x.search_dir
51
+
"@[<hov>roots: %a@;output_file: %a@;json: %b@;search_dir: %a@]"
52
+
(Fmt.list Fpath.pp) x.roots Fpath.pp x.output_file x.json Fpath.pp
53
+
x.search_dir
53
54
54
55
type 'a unit = {
55
56
parent_id : Odoc.Id.t;
+1
-1
src/driver/odoc_unit.mli
+1
-1
src/driver/odoc_unit.mli
+2
-6
src/driver/odoc_units_of.ml
+2
-6
src/driver/odoc_units_of.ml
···
78
78
in
79
79
80
80
let index_of pkg =
81
-
let pkg_libs =
82
-
List.map (fun l -> l.Packages.lib_name) pkg.Packages.libraries
83
-
|> Util.StringSet.of_list
84
-
in
85
-
let pkg_args = base_args pkg pkg_libs in
81
+
let roots = [ Fpath.( // ) odocl_dir (doc_dir pkg) ] in
86
82
let output_file = Fpath.(index_dir / pkg.name / Odoc.index_filename) in
87
83
let sidebar =
88
84
let output_file = Fpath.(index_dir / pkg.name / Odoc.sidebar_filename) in
89
85
{ output_file; json = false }
90
86
in
91
87
{
92
-
pkg_args;
88
+
roots;
93
89
output_file;
94
90
json = false;
95
91
search_dir = pkg.pkg_dir;
+6
-2
src/driver/run.ml
+6
-2
src/driver/run.ml
···
68
68
Logs.err (fun m -> m "%d - Process exitted %d: stderr=%s" myn n err);
69
69
failwith "Error"
70
70
| `Signaled n ->
71
-
Logs.err (fun m -> m "%d - Signalled %d: stderr=%s" myn n err);
72
-
failwith ("Signaled " ^ string_of_int n)
71
+
let err =
72
+
Format.sprintf "Error from %s\n%d - Signalled %d: stderr=%s"
73
+
(String.concat " " cmd) myn n err
74
+
in
75
+
Logs.err (fun m -> m "%s" err);
76
+
failwith err
73
77
with Eio.Exn.Io _ as ex ->
74
78
let bt = Printexc.get_raw_backtrace () in
75
79
Eio.Exn.reraise_with_context ex bt "%d - running command: %a" myn
+2
-1
src/html/generator.ml
+2
-1
src/html/generator.ml
···
543
543
| None -> None
544
544
| Some sidebar ->
545
545
let sidebar = Odoc_document.Sidebar.to_block sidebar url in
546
-
(Some (block ~config ~resolve sidebar) :> any Html.elt list option)
546
+
(Some (List.concat_map (block ~config ~resolve) sidebar)
547
+
:> any Html.elt list option)
547
548
in
548
549
let i = Doctree.Shift.compute ~on_sub i in
549
550
let uses_katex = Doctree.Math.has_math_elements p in
+2
src/index/entry.ml
+2
src/index/entry.ml
+2
src/index/entry.mli
+2
src/index/entry.mli
+1
-12
src/index/odoc_index.ml
+1
-12
src/index/odoc_index.ml
···
2
2
module Entry = Entry
3
3
module Page_hierarchy = Page_hierarchy
4
4
5
-
type page = { p_name : string; p_hierarchy : Page_hierarchy.t }
6
-
7
-
type lib_hierarchies = Skeleton.t list
8
-
type lib = { l_name : string; l_hierarchies : lib_hierarchies }
9
-
10
-
type t = {
11
-
pages : page list;
12
-
libs : lib list;
13
-
extra : Skeleton.t list;
14
-
(** This extra table is used only for search. It was introduced before
15
-
Odoc 3 *)
16
-
}
5
+
type t = Skeleton.t list
+71
-30
src/index/page_hierarchy.ml
+71
-30
src/index/page_hierarchy.ml
···
7
7
8
8
module CPH = Id.Hashtbl.ContainerPage
9
9
module LPH = Id.Hashtbl.LeafPage
10
+
module RMH = Id.Hashtbl.RootModule
10
11
11
12
type page = Id.Page.t
12
-
type leaf_page = Id.LeafPage.t
13
13
type container_page = Id.ContainerPage.t
14
14
15
15
open Astring
16
16
17
17
type title = Comment.link_content
18
18
19
-
type payload = {
20
-
title : title;
21
-
children_order : Frontmatter.children_order option;
19
+
type payload = (* { title : title; frontmatter : Frontmatter.t } *) Lang.Page.t
20
+
21
+
type dir_content = {
22
+
leafs : payload LPH.t;
23
+
dirs : in_progress CPH.t;
24
+
modules : Skeleton.t RMH.t;
22
25
}
23
-
24
-
type dir_content = { leafs : payload LPH.t; dirs : in_progress CPH.t }
25
26
and in_progress = container_page option * dir_content
26
27
27
-
let empty_t dir_id = (dir_id, { leafs = LPH.create 10; dirs = CPH.create 10 })
28
+
let empty_t dir_id =
29
+
( dir_id,
30
+
{ leafs = LPH.create 10; dirs = CPH.create 10; modules = RMH.create 10 } )
28
31
29
32
let get_parent id : container_page option =
30
33
let id :> page = id in
···
38
41
39
42
let leafs (_, dir_content) =
40
43
LPH.fold
41
-
(fun id { title = payload; _ } acc ->
42
-
if String.equal "index" (Id.name id) then acc else (id, payload) :: acc)
44
+
(fun id page acc ->
45
+
if String.equal "index" (Id.name id) then acc else (id, page) :: acc)
43
46
dir_content.leafs []
44
47
45
48
let dirs (_, dir_content) =
46
49
CPH.fold (fun id payload acc -> (id, payload) :: acc) dir_content.dirs []
50
+
51
+
let modules (_, dir_content) =
52
+
RMH.fold (fun id payload acc -> (id, payload) :: acc) dir_content.modules []
47
53
48
54
let rec get_or_create (dir : in_progress) (id : container_page) : in_progress =
49
55
let _, { dirs = parent_dirs; _ } =
···
61
67
CPH.add parent_dirs id new_;
62
68
new_
63
69
64
-
let add (dir : in_progress) ((id : leaf_page), title, children_order) =
70
+
let add_page (dir : in_progress) page =
71
+
match page.Lang.Page.name with
72
+
| { iv = #Id.LeafPage.t_pv; _ } as id ->
73
+
let _, dir_content =
74
+
match get_parent id with
75
+
| Some parent -> get_or_create dir parent
76
+
| None -> dir
77
+
in
78
+
LPH.replace dir_content.leafs id page
79
+
| _ -> ()
80
+
81
+
let add_module (dir : in_progress) m =
65
82
let _, dir_content =
66
-
match get_parent id with
67
-
| Some parent -> get_or_create dir parent
68
-
| None -> dir
83
+
match m.Lang.Compilation_unit.id.iv with
84
+
| `Root (Some parent, _) -> get_or_create dir parent
85
+
| `Root (None, _) -> dir
69
86
in
70
-
LPH.replace dir_content.leafs id { title; children_order }
87
+
let skel = Skeleton.from_unit m in
88
+
RMH.replace dir_content.modules m.id skel
71
89
72
90
let dir_index ((parent_id, _) as dir) =
73
91
let index_id = Id.Mk.leaf_page (parent_id, PageName.make_std "index") in
74
92
match find_leaf dir index_id with
75
-
| Some payload -> Some (payload, index_id, payload.title)
93
+
| Some payload -> Some (index_id, payload)
76
94
| None -> None
77
95
78
-
type index =
79
-
| Page of Id.Page.t * title
80
-
| Missing_index of Id.ContainerPage.t option
81
-
82
-
type t = index Odoc_utils.Tree.t
96
+
type t = Entry.t Tree.t
83
97
84
98
let rec t_of_in_progress (dir : in_progress) : t =
99
+
let entry_of_page page =
100
+
let kind = Entry.Page page.Lang.Page.frontmatter in
101
+
let doc = page.content in
102
+
let id = page.name in
103
+
Entry.entry ~kind ~doc ~id
104
+
in
85
105
let children_order, index =
86
106
match dir_index dir with
87
-
| Some ({ children_order; _ }, index_id, index_title) ->
88
-
(children_order, Page (index_id, index_title))
89
-
| None -> (None, Missing_index (fst dir))
107
+
| Some (_, page) ->
108
+
let children_order = page.frontmatter.children_order in
109
+
let entry = entry_of_page page in
110
+
(children_order, entry)
111
+
| None ->
112
+
let entry =
113
+
match fst dir with
114
+
| Some id ->
115
+
let kind = Entry.Dir in
116
+
let doc = [] in
117
+
Entry.entry ~kind ~doc ~id
118
+
| None ->
119
+
let id =
120
+
(* root dir must have an index page *)
121
+
Id.Mk.leaf_page (None, Names.PageName.make_std "index")
122
+
in
123
+
let kind = Entry.Dir in
124
+
let doc = [] in
125
+
Entry.entry ~kind ~doc ~id
126
+
in
127
+
(None, entry)
90
128
in
91
129
let pp_content fmt (id, _) =
92
130
match id.Id.iv with
···
102
140
let contents =
103
141
let leafs =
104
142
leafs dir
105
-
|> List.map (fun (id, payload) ->
106
-
let id :> Id.Page.t = id in
107
-
(id, Tree.leaf (Page (id, payload))))
143
+
|> List.map (fun (_, page) ->
144
+
let id :> Id.Page.t = page.Lang.Page.name in
145
+
let entry = entry_of_page page in
146
+
(id, Tree.leaf entry))
108
147
in
109
148
let dirs =
110
149
dirs dir
···
178
217
String.compare (Paths.Identifier.name x) (Paths.Identifier.name y))
179
218
unordered
180
219
in
220
+
let modules = modules dir |> List.map snd in
181
221
let contents = ordered @ unordered |> List.map snd in
182
-
{ Tree.node = index; children = contents }
222
+
{ Tree.node = index (* , modules *); children = contents @ modules }
183
223
184
224
let rec remove_common_root (v : t) =
185
225
match v with
186
-
| { Tree.children = [ v ]; node = Missing_index _ } -> remove_common_root v
226
+
| { Tree.children = [ v ]; node = { kind = Dir; _ } } -> remove_common_root v
187
227
| _ -> v
188
228
189
-
let of_list l =
229
+
let of_list ~pages ~modules =
190
230
let dir = empty_t None in
191
-
List.iter (add dir) l;
231
+
List.iter (add_page dir) pages;
232
+
List.iter (add_module dir) modules;
192
233
t_of_in_progress dir |> remove_common_root
+2
-7
src/index/page_hierarchy.mli
+2
-7
src/index/page_hierarchy.mli
···
1
1
open Odoc_model
2
-
open Odoc_model.Paths
3
2
open Odoc_utils
4
3
5
4
(** Page hierarchies represent a hierarchy of pages. *)
6
5
7
6
type title = Comment.link_content
8
7
9
-
type index =
10
-
| Page of Paths.Identifier.Page.t * title
11
-
| Missing_index of Paths.Identifier.ContainerPage.t option
12
-
13
-
type t = index Tree.t
8
+
type t = Entry.t Tree.t
14
9
15
10
val of_list :
16
-
(Identifier.LeafPage.t * title * Frontmatter.children_order option) list -> t
11
+
pages:Lang.Page.t list -> modules:Lang.Compilation_unit.t list -> t
17
12
(** Uses the convention that the [index] children passes its payload to the
18
13
container directory to output a payload *)
+1
src/model/paths.ml
+1
src/model/paths.ml
+1
src/model/paths.mli
+1
src/model/paths.mli
···
244
244
module Any : Hashtbl.S with type key = Any.t
245
245
module ContainerPage : Hashtbl.S with type key = ContainerPage.t
246
246
module LeafPage : Hashtbl.S with type key = LeafPage.t
247
+
module RootModule : Hashtbl.S with type key = RootModule.t
247
248
end
248
249
249
250
module Mk : sig
+11
-24
src/odoc/bin/main.ml
+11
-24
src/odoc/bin/main.ml
···
468
468
| None, `JSON -> Ok (Fs.File.of_string "index.json")
469
469
| None, `Marshall -> Ok (Fs.File.of_string "index.odoc-index")
470
470
471
-
let index dst json warnings_options page_roots lib_roots inputs_in_file inputs
472
-
occurrences =
471
+
let index dst json warnings_options roots inputs_in_file inputs occurrences =
473
472
let marshall = if json then `JSON else `Marshall in
474
473
output_file ~dst marshall >>= fun output ->
475
-
Antichain.check (page_roots |> List.map ~f:snd) ~opt:"-P" >>= fun () ->
476
-
Antichain.check (lib_roots |> List.map ~f:snd) ~opt:"-L" >>= fun () ->
477
-
Indexing.compile marshall ~output ~warnings_options ~occurrences ~lib_roots
478
-
~page_roots ~inputs_in_file ~odocls:inputs
474
+
Antichain.check roots ~opt:"--root" >>= fun () ->
475
+
Indexing.compile marshall ~output ~warnings_options ~roots ~occurrences
476
+
~inputs_in_file ~odocls:inputs
479
477
480
478
let cmd =
481
479
let dst =
···
511
509
let doc = ".odocl file to index" in
512
510
Arg.(value & pos_all convert_fpath [] & info ~doc ~docv:"FILE" [])
513
511
in
514
-
let page_roots =
512
+
let roots =
515
513
let doc =
516
-
"Specifies a directory PATH containing pages that should be included \
517
-
in the sidebar, under the NAME section."
514
+
"Specifies a directory PATH containing pages or units that should be \
515
+
included in the sidebar."
518
516
in
519
517
Arg.(
520
518
value
521
-
& opt_all convert_named_root []
522
-
& info ~docs ~docv:"NAME:PATH" ~doc [ "P" ])
523
-
in
524
-
let lib_roots =
525
-
let doc =
526
-
"Specifies a directory PATH containing units that should be included \
527
-
in the sidebar, as part of the LIBNAME library."
528
-
in
529
-
530
-
Arg.(
531
-
value
532
-
& opt_all convert_named_root []
533
-
& info ~docs ~docv:"LIBNAME:PATH" ~doc [ "L" ])
519
+
& opt_all (convert_directory ()) []
520
+
& info ~docs ~docv:"NAME:PATH" ~doc [ "root" ])
534
521
in
535
522
Term.(
536
523
const handle_error
537
-
$ (const index $ dst $ json $ warnings_options $ page_roots $ lib_roots
538
-
$ inputs_in_file $ inputs $ occurrences))
524
+
$ (const index $ dst $ json $ warnings_options $ roots $ inputs_in_file
525
+
$ inputs $ occurrences))
539
526
540
527
let info ~docs =
541
528
let doc =
+18
-87
src/odoc/indexing.ml
+18
-87
src/odoc/indexing.ml
···
10
10
let handle_file file ~unit ~page ~occ =
11
11
match Fpath.basename file with
12
12
| s when String.is_prefix ~affix:"index-" s ->
13
-
Odoc_file.load_index file >>= fun { extra (* libs *); _ } ->
14
-
Ok (occ extra)
13
+
Odoc_file.load_index file
14
+
>>= fun (* { extra (\* libs *\); _ } *) sidebar -> Ok (occ sidebar)
15
15
| _ -> (
16
16
Odoc_file.load file >>= fun unit' ->
17
17
match unit' with
···
75
75
Format.fprintf output "]";
76
76
Ok ()
77
77
78
-
let compile_to_marshall ~output (pages, libs) files =
79
-
let unit u = [ Odoc_index.Skeleton.from_unit u ] in
80
-
let page p = [ Odoc_index.Skeleton.from_page p ] in
81
-
let index i = i in
82
-
let extra =
83
-
List.concat_map
84
-
~f:(fun file ->
85
-
match handle_file ~unit ~page ~occ:index file with
86
-
| Ok l -> l
87
-
| Error (`Msg m) ->
88
-
Error.raise_warning ~non_fatal:true
89
-
(Error.filename_only "%s" m (Fs.File.to_string file));
90
-
[])
91
-
files
92
-
in
93
-
let content = { Odoc_index.pages; libs; extra } in
94
-
Ok (Odoc_file.save_index output content)
78
+
let compile_to_marshall ~output hierarchy =
79
+
Ok (Odoc_file.save_index output hierarchy)
95
80
96
81
let read_occurrences file =
97
82
let ic = open_in_bin file in
98
83
let htbl : Odoc_occurrences.Table.t = Marshal.from_channel ic in
99
84
htbl
100
85
101
-
let pages resolver page_roots =
102
-
List.map
103
-
(fun (page_root, _) ->
104
-
let pages = Resolver.all_pages ~root:page_root resolver in
105
-
let p_hierarchy =
106
-
let page_toc_input =
107
-
(* To create a page toc, we need a list with id, title and children
108
-
order. We generate this list from *)
109
-
let prepare_input (id, title, frontmatter) =
110
-
(* We filter non-leaf pages *)
111
-
match id with
112
-
| { Id.iv = #Id.LeafPage.t_pv; _ } as id ->
113
-
(* We generate a title if needed *)
114
-
let title =
115
-
match title with
116
-
| None -> Location_.[ at (span []) (`Word (Id.name id)) ]
117
-
| Some x -> x
118
-
in
119
-
let children_order = frontmatter.Frontmatter.children_order in
120
-
Some (id, title, children_order)
121
-
| _ -> None
122
-
in
123
-
List.filter_map prepare_input pages
124
-
in
125
-
Odoc_index.Page_hierarchy.of_list page_toc_input
126
-
in
127
-
{ Odoc_index.p_name = page_root; p_hierarchy })
128
-
page_roots
129
-
130
-
let libs resolver lib_roots =
131
-
List.map
132
-
(fun (library, _) ->
133
-
let units = Resolver.all_units ~library resolver in
134
-
let l_hierarchies =
135
-
List.filter_map
136
-
(fun (file, _id) ->
137
-
match file () with
138
-
| Some unit -> Some (Odoc_index.Skeleton.from_unit unit)
139
-
| None -> None)
140
-
units
141
-
in
142
-
{ Odoc_index.l_name = library; l_hierarchies })
143
-
lib_roots
144
-
145
-
let compile out_format ~output ~warnings_options ~occurrences ~lib_roots
146
-
~page_roots ~inputs_in_file ~odocls =
86
+
let compile out_format ~output ~warnings_options ~occurrences ~roots
87
+
~inputs_in_file ~odocls =
147
88
let handle_warnings f =
148
89
let res = Error.catch_warnings f in
149
90
Error.handle_warnings ~warnings_options res |> Result.join
150
91
in
151
92
handle_warnings @@ fun () ->
152
-
let current_dir = Fs.File.dirname output in
153
93
parse_input_files inputs_in_file >>= fun files ->
154
94
let files = List.rev_append odocls files in
155
95
let occurrences =
···
157
97
| None -> None
158
98
| Some occurrences -> Some (read_occurrences (Fpath.to_string occurrences))
159
99
in
160
-
let includes_rec =
161
-
List.rev_append (List.map snd page_roots) (List.map snd lib_roots)
162
-
in
163
100
let files =
164
101
List.rev_append files
165
-
(includes_rec
102
+
(roots
166
103
|> List.map (fun include_rec ->
167
104
Fs.Directory.fold_files_rec ~ext:"odocl"
168
105
(fun files file -> file :: files)
169
106
[] include_rec)
170
107
|> List.concat)
171
108
in
109
+
let pages, modules =
110
+
let read (pages, modules) f =
111
+
match Odoc_file.load f with
112
+
| Ok { content = Page_content p; _ } -> (p :: pages, modules)
113
+
| Ok { content = Unit_content m; _ } -> (pages, m :: modules)
114
+
| _ -> (pages, modules)
115
+
in
116
+
List.fold_left read ([], []) files
117
+
in
118
+
let hierarchy = Odoc_index.Page_hierarchy.of_list ~pages ~modules in
172
119
match out_format with
173
120
| `JSON -> compile_to_json ~output ~occurrences files
174
-
| `Marshall ->
175
-
let resolver =
176
-
Resolver.create ~important_digests:false ~directories:[]
177
-
~roots:
178
-
(Some
179
-
{
180
-
page_roots;
181
-
lib_roots;
182
-
current_lib = None;
183
-
current_package = None;
184
-
current_dir;
185
-
})
186
-
~open_modules:[]
187
-
in
188
-
let pages = pages resolver page_roots in
189
-
let libs = libs resolver lib_roots in
190
-
compile_to_marshall ~output (pages, libs) files
121
+
| `Marshall -> compile_to_marshall ~output [ hierarchy ]
+1
-2
src/odoc/indexing.mli
+1
-2
src/odoc/indexing.mli
···
14
14
output:Fs.file ->
15
15
warnings_options:Odoc_model.Error.warnings_options ->
16
16
occurrences:Fs.file option ->
17
-
lib_roots:(string * Fs.directory) list ->
18
-
page_roots:(string * Fs.directory) list ->
17
+
roots:Fs.Directory.t list ->
19
18
inputs_in_file:Fs.file list ->
20
19
odocls:Fs.file list ->
21
20
(unit, [> msg ]) result
+4
-5
src/odoc/odoc_file.mli
+4
-5
src/odoc/odoc_file.mli
···
19
19
open Odoc_model
20
20
open Or_error
21
21
22
-
type unit_content = Lang.Compilation_unit.t
23
-
24
-
(** Either a page or a module. *)
22
+
(** Either a page or a module or something else. *)
25
23
type content =
26
24
| Page_content of Lang.Page.t
27
25
| Impl_content of Lang.Implementation.t
28
-
| Unit_content of unit_content
26
+
| Unit_content of Lang.Compilation_unit.t
29
27
| Asset_content of Lang.Asset.t
30
28
31
29
type t = { content : content; warnings : Error.t list }
···
35
33
val save_page : Fs.File.t -> warnings:Error.t list -> Lang.Page.t -> unit
36
34
(** Save a page. The [page-] prefix is added to the file name if missing. *)
37
35
38
-
val save_unit : Fs.File.t -> warnings:Error.t list -> unit_content -> unit
36
+
val save_unit :
37
+
Fs.File.t -> warnings:Error.t list -> Lang.Compilation_unit.t -> unit
39
38
(** Save a module. *)
40
39
41
40
val save_impl :
+7
-1
src/search/html.ml
+7
-1
src/search/html.ml
···
126
126
127
127
let kind_doc = "doc"
128
128
129
+
let kind_page = "page"
130
+
131
+
let kind_dir = "dir"
132
+
129
133
let kind_typedecl = "type"
130
134
131
135
let kind_module = "mod"
···
165
169
| TypeExtension _ -> kind_extension
166
170
| ModuleType _ -> kind_module_type
167
171
| Doc -> kind_doc
172
+
| Page _ -> kind_page
173
+
| Dir -> kind_dir
168
174
169
175
let value_rhs (t : Entry.value_entry) = " : " ^ Text.of_type t.type_
170
176
···
182
188
Some (constructor_rhs t)
183
189
| Field f -> Some (field_rhs f)
184
190
| Module _ | Class_type _ | Method _ | Class _ | TypeExtension _
185
-
| ModuleType _ | Doc ->
191
+
| ModuleType _ | Doc | Page _ | Dir ->
186
192
None
187
193
188
194
let names_of_id id =
+2
src/search/json_index/json_search.ml
+2
src/search/json_index/json_search.ml
+11
-13
test/frontmatter/toc_order.t/run.t
+11
-13
test/frontmatter/toc_order.t/run.t
···
12
12
$ odoc link _odoc/pkg/dir1/page-content_in_dir.odoc
13
13
$ odoc link _odoc/pkg/dir1/page-dontent.odoc
14
14
15
-
$ odoc compile-index -P test:_odoc/pkg
15
+
$ odoc compile-index --root _odoc/pkg
16
16
File "index.mld", line 1, characters 30-35:
17
17
Warning: Duplicate 'dir1/' in (children).
18
18
File "index.mld", line 1, characters 36-40:
···
62
62
but this should be a warning!
63
63
64
64
$ cat _html/pkg/index.html | grep odoc-global-toc -A 11
65
-
<nav class="odoc-toc odoc-global-toc"><ul class="odoc-modules"></ul>
66
-
<b>Documentation</b>
67
-
<ul class="odoc-pages">
68
-
<li><a href="#" class="current_unit">This is the main index</a>
69
-
<ul><li><a href="content.html">This is top level content</a></li>
70
-
<li><a href="dir1/index.html">This is dir1's index</a>
71
-
<ul>
72
-
<li>
73
-
<a href="dir1/content_in_dir.html">This is some content in dir1</a>
74
-
</li><li><a href="dir1/dontent.html">The name is dontent</a></li>
75
-
</ul>
76
-
</li><li><a href="omitted.html">This one is omitted</a></li>
65
+
<nav class="odoc-toc odoc-global-toc">
66
+
<a href="#" class="current_unit">index</a>
67
+
<ul><li><a href="content.html">This is top level content</a></li>
68
+
<li><a href="dir1/index.html">This is dir1's index</a></li>
69
+
<li><a href="omitted.html">This one is omitted</a></li>
70
+
</ul>
71
+
</nav>
72
+
</div><div class="odoc-content"></div>
73
+
</body>
74
+
</html>
77
75
78
76
79
77
Some more parsing test:
+7
test/odoc_print/dune
+7
test/odoc_print/dune
···
9
9
(libraries odoc_odoc type_desc_to_yojson odoc_model_desc compatcmdliner))
10
10
11
11
(executable
12
+
(public_name odoc_print_index)
13
+
(package odoc)
14
+
(name print_index)
15
+
(modules print_index)
16
+
(libraries odoc_odoc type_desc_to_yojson odoc_model_desc compatcmdliner yojson odoc_json_index))
17
+
18
+
(executable
12
19
(name occurrences_print)
13
20
(modules occurrences_print)
14
21
(libraries odoc_model_desc compatcmdliner odoc_odoc))
+35
test/odoc_print/print_index.ml
+35
test/odoc_print/print_index.ml
···
1
+
open Compatcmdliner
2
+
3
+
let run inp =
4
+
let inp = Fpath.v inp in
5
+
let index = Odoc_odoc.Odoc_file.load_index inp |> Result.get_ok in
6
+
let rec tree_to_yojson
7
+
({ node; children } : Odoc_index.Entry.t Odoc_utils.Tree.t) :
8
+
Yojson.Safe.t =
9
+
let entry =
10
+
Odoc_json_index.Json_display.of_entry node [] |> Odoc_html.Json.to_string
11
+
in
12
+
`Assoc
13
+
[
14
+
("node", `String entry);
15
+
("children", `List (List.map tree_to_yojson children));
16
+
]
17
+
in
18
+
List.iter
19
+
(fun s -> s |> tree_to_yojson |> Format.printf "%a" Yojson.Safe.pp)
20
+
index
21
+
22
+
let a_inp =
23
+
let doc = "Input file." in
24
+
Arg.(required & pos 0 (some file) None & info ~doc ~docv:"PATH" [])
25
+
26
+
let term =
27
+
let doc =
28
+
"Print the content of occurrences files into a text format. For tests"
29
+
in
30
+
Term.(const run $ a_inp, info "occurrences_print" ~doc)
31
+
32
+
let () =
33
+
match Term.eval term with
34
+
| `Ok () -> ()
35
+
| (`Version | `Help | `Error _) as x -> Term.exit x
+23
-12
test/parent_id/missing_indexes.t/run.t
+23
-12
test/parent_id/missing_indexes.t/run.t
···
7
7
$ odoc link _odoc/page-foo.odoc
8
8
$ odoc link _odoc/page-bar.odoc
9
9
$ odoc link _odoc/baz/page-bli.odoc
10
-
$ odoc compile-index -P _:_odoc
10
+
$ odoc compile-index --root _odoc
11
11
$ odoc sidebar-generate index.odoc-index
12
12
13
13
$ odoc html-generate --sidebar sidebar.odoc-sidebar --indent --output-dir _html _odoc/page-foo.odocl
14
14
15
15
Missing index for Baz makes it unclickable but use the ID for the name.
16
-
Root is used for the missing index in the unnamed root directory.
17
-
$ cat _html/foo.html | grep Documentation -A 8
18
-
<b>Documentation</b>
19
-
<ul class="odoc-pages">
20
-
<li>Root
21
-
<ul><li><a href="bar.html">Bar</a></li>
22
-
<li>baz<ul><li><a href="baz/bli.html">Bli</a></li></ul></li>
23
-
<li><a href="#" class="current_unit">Foo</a></li>
24
-
</ul>
25
-
</li>
26
-
</ul>
16
+
Root is used for the missing index in the unnamed root directory. TODO
17
+
$ cat _html/foo.html
18
+
<!DOCTYPE html>
19
+
<html xmlns="http://www.w3.org/1999/xhtml">
20
+
<head><title>foo (foo)</title><meta charset="utf-8"/>
21
+
<link rel="stylesheet" href="odoc.css"/>
22
+
<meta name="generator" content="odoc %%VERSION%%"/>
23
+
<meta name="viewport" content="width=device-width,initial-scale=1.0"/>
24
+
<script src="highlight.pack.js"></script>
25
+
<script>hljs.initHighlightingOnLoad();</script>
26
+
</head>
27
+
<body class="odoc">
28
+
<header class="odoc-preamble">
29
+
<h1 id="foo"><a href="#foo" class="anchor"></a>Foo</h1>
30
+
</header>
31
+
<div class="odoc-tocs">
32
+
<nav class="odoc-toc odoc-global-toc"><a href="index.html">index</a>
33
+
<ul><li><a href="#" class="current_unit">Foo</a></li></ul>
34
+
</nav>
35
+
</div><div class="odoc-content"></div>
36
+
</body>
37
+
</html>
+1
-1
test/roots_and_hierarchy/canonical_hierarchy.t/run.t
+1
-1
test/roots_and_hierarchy/canonical_hierarchy.t/run.t
···
23
23
24
24
Let's html-generate it (with a sidebar):
25
25
26
-
$ odoc compile-index -P pkg:_odoc/pkg/ -L libname:_odoc/pkg/libname
26
+
$ odoc compile-index --root _odoc/pkg/
27
27
$ odoc sidebar-generate index.odoc-index
28
28
29
29
$ odoc html-generate --indent --sidebar sidebar.odoc-sidebar -o html _odoc/pkg/page-file.odocl
+1
-1
test/roots_and_hierarchy/separate_doc_lib_folders.t/run.t
+1
-1
test/roots_and_hierarchy/separate_doc_lib_folders.t/run.t
···
23
23
24
24
Let's html-generate it (with a sidebar):
25
25
26
-
$ odoc compile-index -P pkg:_odoc/pkg/doc/ -L libname:_odoc/pkg/lib/libname
26
+
$ odoc compile-index --root _odoc/pkg/doc/ --root _odoc/pkg/lib/libname
27
27
$ odoc sidebar-generate index.odoc-index
28
28
29
29
$ odoc html-generate --indent --sidebar sidebar.odoc-sidebar -o html _odoc/pkg/doc/page-file.odocl
+5
-8
test/search/html_search.t/run.t
+5
-8
test/search/html_search.t/run.t
···
65
65
passing directly the name of the files.
66
66
67
67
$ printf "main.odocl\npage-page.odocl\nj.odocl\n" > index_map
68
-
$ odoc compile-index --json -o index.json -P pkgname:.
68
+
$ odoc compile-index --json -o index.json --root .
69
69
70
-
$ odoc compile-index -o index-main.odoc-index -P pkgname:.
70
+
$ odoc compile-index -o index-main.odoc-index --root .
71
71
72
72
The json index file contains a json array, each element of the array corresponding to
73
73
a search entry.
···
214
214
215
215
Passing an inexistent file:
216
216
217
-
$ odoc compile-index -P pkgname:babar
217
+
$ odoc compile-index --root babar
218
218
$ odoc compile-index --file-list babar
219
219
odoc: option '--file-list': no 'babar' file or directory
220
220
Usage: odoc compile-index [--file-list=FILE] [--json] [OPTION]… [FILE]…
···
224
224
Passing an empty folder is allowed:
225
225
226
226
$ mkdir foo
227
-
$ odoc compile-index -P pkgname:foo
227
+
$ odoc compile-index --root foo
228
228
229
229
Wrong file extensions:
230
230
···
241
241
Passing a file which is not a correctly marshalled one:
242
242
243
243
$ echo hello > my_file.odocl
244
-
$ odoc compile-index -P pkgname:.
245
-
File "./my_file.odocl":
246
-
Warning: Error while unmarshalling "./my_file.odocl": End_of_file
247
-
244
+
$ odoc compile-index --root .
248
245
249
246
250
247
Passing no file is allowed, generating an empty index:
+1
-1
test/search/id_standalone_comments.t/run.t
+1
-1
test/search/id_standalone_comments.t/run.t
···
7
7
$ odoc compile -I . main.cmt
8
8
$ odoc link -I . main.odoc
9
9
10
-
$ odoc compile-index --json -P pkgname:./
10
+
$ odoc compile-index --json --root ./
11
11
We test that you can also pass a .odocl file directly.
12
12
$ odoc compile-index --json main.odocl -o index2.json
13
13
Indexes should be the same no matter how the inputs were passed.
+1
-1
test/search/module_aliases.t/run.t
+1
-1
test/search/module_aliases.t/run.t