Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Further voodoo #1252

Merged
merged 8 commits into from
Dec 18, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
7 changes: 7 additions & 0 deletions src/driver/common_args.ml
Original file line number Diff line number Diff line change
Expand Up @@ -40,6 +40,10 @@ let odoc_bin =
let doc = "Odoc binary to use" in
Arg.(value & opt (some string) None & info [ "odoc" ] ~doc)

let odoc_md_bin =
let doc = "Odoc-md binary to use" in
Arg.(value & opt (some string) None & info [ "odoc-md" ] ~doc)

let compile_grep =
let doc = "Show compile commands containing the string" in
Arg.(value & opt (some string) None & info [ "compile-grep" ] ~doc)
Expand Down Expand Up @@ -74,6 +78,7 @@ type t = {
stats : bool;
nb_workers : int;
odoc_bin : string option;
odoc_md_bin : string option;
compile_grep : string option;
link_grep : string option;
generate_grep : string option;
Expand All @@ -95,6 +100,7 @@ let term =
and+ stats = stats
and+ nb_workers = nb_workers
and+ odoc_bin = odoc_bin
and+ odoc_md_bin = odoc_md_bin
and+ compile_grep = compile_grep
and+ generate_json = generate_json
and+ link_grep = link_grep
Expand All @@ -111,6 +117,7 @@ let term =
stats;
nb_workers;
odoc_bin;
odoc_md_bin;
compile_grep;
link_grep;
generate_grep;
Expand Down
5 changes: 4 additions & 1 deletion src/driver/compile.ml
Original file line number Diff line number Diff line change
Expand Up @@ -278,8 +278,11 @@ let html_generate ~occurrence_file ~remaps ~generate_json output_dir linked =
let sidebar =
match sidebar with
| None -> None
| Some { output_file; json } ->
| Some { output_file; json; pkg_dir } ->
Odoc.sidebar_generate ~output_file ~json index.output_file ();
Odoc.sidebar_generate
~output_file:Fpath.(output_dir // pkg_dir / "sidebar.json")
~json:true index.output_file ();
Comment on lines +283 to +285
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Where is this json file used ? I find this code a bit brittle because if this file is ever needed somewhere else, nothing will ensure that it continues to be generated.
Any way the caller could set json = true ?

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It's used by ocaml.org - this is the sidebar json that served up for the per-package sidebar. The ocaml.org server reads this and renders its own sidebar.

Some output_file
in
(sherlodoc_index_one ~output_dir index, sidebar)
Expand Down
1 change: 1 addition & 0 deletions src/driver/dune_style.ml
Original file line number Diff line number Diff line change
Expand Up @@ -125,6 +125,7 @@ let of_dune_build dir =
selected = false;
remaps = [];
pkg_dir;
doc_dir = pkg_dir;
other_docs = [];
config = Global_config.empty;
} )
Expand Down
1 change: 1 addition & 0 deletions src/driver/odoc.mli
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,7 @@ val index_filename : string
val sidebar_filename : string

val odoc : Bos.Cmd.t ref
val odoc_md : Bos.Cmd.t ref

type compile_deps = { digest : Digest.t; deps : (string * Digest.t) list }
val compile_deps : Fpath.t -> (compile_deps, [> `Msg of string ]) result
Expand Down
19 changes: 13 additions & 6 deletions src/driver/odoc_driver.ml
Original file line number Diff line number Diff line change
Expand Up @@ -135,6 +135,7 @@ let run mode
stats;
nb_workers;
odoc_bin;
odoc_md_bin;
compile_grep;
link_grep;
generate_grep;
Expand All @@ -143,6 +144,10 @@ let run mode
generate_json;
} =
Option.iter (fun odoc_bin -> Odoc.odoc := Bos.Cmd.v odoc_bin) odoc_bin;
Option.iter
(fun odoc_md_bin -> Odoc.odoc_md := Bos.Cmd.v odoc_md_bin)
odoc_md_bin;

let _ = Voodoo.find_universe_and_version "foo" in
Eio_main.run @@ fun env ->
Eio.Switch.run @@ fun sw ->
Expand All @@ -151,22 +156,24 @@ let run mode
Stats.init_nprocs nb_workers;
let () = Worker_pool.start_workers env sw nb_workers in

let all, extra_paths, actions =
let all, extra_paths, actions, gen_indices =
match mode with
| Voodoo { package_name = p; blessed; actions } ->
let all = Voodoo.of_voodoo p ~blessed in
let extra_paths = Voodoo.extra_paths odoc_dir in
(all, extra_paths, actions)
(all, extra_paths, actions, false)
| Dune { path } ->
(Dune_style.of_dune_build path, Voodoo.empty_extra_paths, All)
(Dune_style.of_dune_build path, Voodoo.empty_extra_paths, All, true)
| OpamLibs { libs } ->
( Packages.of_libs ~packages_dir:None (Util.StringSet.of_list libs),
Voodoo.empty_extra_paths,
All )
All,
true )
| OpamPackages { packages } ->
( Packages.of_packages ~packages_dir:None packages,
Voodoo.empty_extra_paths,
All )
All,
true )
in

let virtual_check =
Expand Down Expand Up @@ -221,7 +228,7 @@ let run mode
let odocl_dir = Option.value odocl_dir ~default:odoc_dir in
{ Odoc_unit.odoc_dir; odocl_dir; index_dir; mld_dir }
in
Odoc_units_of.packages ~dirs ~extra_paths ~remap all
Odoc_units_of.packages ~dirs ~gen_indices ~extra_paths ~remap all
in
Compile.init_stats units;
let compiled =
Expand Down
9 changes: 5 additions & 4 deletions src/driver/odoc_unit.ml
Original file line number Diff line number Diff line change
Expand Up @@ -44,7 +44,7 @@ module Pkg_args = struct
(Util.StringMap.bindings x.libs)
end

type sidebar = { output_file : Fpath.t; json : bool }
type sidebar = { output_file : Fpath.t; json : bool; pkg_dir : Fpath.t }

type index = {
roots : Fpath.t list;
Expand Down Expand Up @@ -126,9 +126,10 @@ and pp : all_kinds unit Fmt.t =
(Fmt.option pp_index) x.index pp_kind
(x.kind :> all_kinds)

let doc_dir pkg = pkg.Packages.pkg_dir
let lib_dir pkg lib = Fpath.(pkg.Packages.pkg_dir / lib.Packages.lib_name)
let src_dir pkg = Fpath.(pkg.Packages.pkg_dir / "src")
let pkg_dir pkg = pkg.Packages.pkg_dir
let doc_dir pkg = pkg.Packages.doc_dir
let lib_dir pkg lib = Fpath.(doc_dir pkg / lib.Packages.lib_name)
let src_dir pkg = Fpath.(doc_dir pkg / "src")
let src_lib_dir pkg lib = Fpath.(src_dir pkg / lib.Packages.lib_name)

type dirs = {
Expand Down
5 changes: 3 additions & 2 deletions src/driver/odoc_unit.mli
Original file line number Diff line number Diff line change
Expand Up @@ -18,7 +18,7 @@ module Pkg_args : sig
val pp : t Fmt.t
end

type sidebar = { output_file : Fpath.t; json : bool }
type sidebar = { output_file : Fpath.t; json : bool; pkg_dir : Fpath.t }
type index = {
roots : Fpath.t list;
output_file : Fpath.t;
Expand Down Expand Up @@ -55,10 +55,11 @@ type t = [ impl | intf | mld | asset | md ] unit

val pp : t Fmt.t

val pkg_dir : Packages.t -> Fpath.t
val lib_dir : Packages.t -> Packages.libty -> Fpath.t
val doc_dir : Packages.t -> Fpath.t
val src_lib_dir : Packages.t -> Packages.libty -> Fpath.t
val src_dir : Packages.t -> Fpath.t
val src_lib_dir : Packages.t -> Packages.libty -> Fpath.t

type dirs = {
odoc_dir : Fpath.t;
Expand Down
17 changes: 10 additions & 7 deletions src/driver/odoc_units_of.ml
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
open Odoc_unit

let packages ~dirs ~extra_paths ~remap (pkgs : Packages.t list) : t list =
let packages ~dirs ~extra_paths ~remap ~gen_indices (pkgs : Packages.t list) :
t list =
let { odoc_dir; odocl_dir; index_dir; mld_dir = _ } = dirs in
(* [module_of_hash] Maps a hash to the corresponding [Package.t], library name and
[Packages.modulety]. [lib_dirs] maps a library name to the odoc dir containing its
Expand Down Expand Up @@ -80,15 +81,16 @@ let packages ~dirs ~extra_paths ~remap (pkgs : Packages.t list) : t list =
let index_of pkg =
let roots = [ Fpath.( // ) odocl_dir (doc_dir pkg) ] in
let output_file = Fpath.(index_dir / pkg.name / Odoc.index_filename) in
let pkg_dir = doc_dir pkg in
let sidebar =
let output_file = Fpath.(index_dir / pkg.name / Odoc.sidebar_filename) in
{ output_file; json = false }
{ output_file; json = false; pkg_dir }
in
{
roots;
output_file;
json = false;
search_dir = pkg.pkg_dir;
search_dir = doc_dir pkg;
sidebar = Some sidebar;
}
in
Expand Down Expand Up @@ -226,7 +228,7 @@ let packages ~dirs ~extra_paths ~remap (pkgs : Packages.t list) : t list =
let ext = Fpath.get_ext md in
match ext with
| ".md" ->
let rel_dir = doc_dir pkg in
let rel_dir = pkg_dir pkg in
let kind = `Md in
let name = md |> Fpath.rem_ext |> Fpath.basename |> ( ^ ) "page-" in
let lib_deps = Util.StringSet.empty in
Expand Down Expand Up @@ -295,6 +297,7 @@ let packages ~dirs ~extra_paths ~remap (pkgs : Packages.t list) : t list =
((pkg_index :: src_index :: lib_units)
@ mld_units @ asset_units @ md_units)
in

let pkg_list :> t = Landing_pages.package_list ~dirs ~remap pkgs in
pkg_list :: List.concat_map of_package pkgs
if gen_indices then
let gen_indices :> t = Landing_pages.package_list ~dirs ~remap pkgs in
gen_indices :: List.concat_map of_package pkgs
else List.concat_map of_package pkgs
1 change: 1 addition & 0 deletions src/driver/odoc_units_of.mli
Original file line number Diff line number Diff line change
Expand Up @@ -4,5 +4,6 @@ val packages :
dirs:dirs ->
extra_paths:Voodoo.extra_paths ->
remap:bool ->
gen_indices:bool ->
Packages.t list ->
t list
87 changes: 46 additions & 41 deletions src/driver/opam.ml
Original file line number Diff line number Diff line change
Expand Up @@ -146,7 +146,47 @@ let pp_fpaths_of_package fmt l =
docs)
l

let classify_contents prefix only_package contents =
let classify_docs prefix only_package contents =
let pkg_match pkg =
match only_package with None -> true | Some p -> p = pkg
in

let is_dir f =
try Sys.is_directory (Fpath.to_string f) with Sys_error _ -> false
in

List.fold_left
(fun acc fpath ->
match Fpath.segs fpath with
| "doc" :: pkg :: "odoc-pages" :: _ :: _
when pkg_match pkg && not (is_dir Fpath.(prefix // fpath)) ->
Logs.debug (fun m -> m "Found odoc page: %a" Fpath.pp fpath);
let kind =
match Fpath.get_ext fpath with ".mld" -> `Mld | _ -> `Asset
in
let rel_path =
Fpath.rem_prefix Fpath.(v "doc" / pkg / "odoc-pages") fpath
|> Option.get
in
{ kind; file = Fpath.(prefix // fpath); rel_path } :: acc
| "doc" :: pkg :: "odoc-assets" :: _ :: _
when pkg_match pkg && not (is_dir Fpath.(prefix // fpath)) ->
Logs.debug (fun m -> m "Found odoc page: %a" Fpath.pp fpath);
let rel_path =
Fpath.rem_prefix Fpath.(v "doc" / pkg / "odoc-assets") fpath
|> Option.get
in
let rel_path = Fpath.(v "_assets" // rel_path) in
{ kind = `Asset; file = Fpath.(prefix // fpath); rel_path } :: acc
| [ "doc"; pkg; _ ]
when pkg_match pkg && not (is_dir Fpath.(prefix // fpath)) ->
Logs.debug (fun m -> m "Found other doc: %a" Fpath.pp fpath);
let rel_path = Fpath.base fpath in
{ kind = `Other; file = Fpath.(prefix // fpath); rel_path } :: acc
| _ -> acc)
[] contents

let classify_libs prefix only_package contents =
let pkg_match pkg =
match only_package with None -> true | Some p -> p = pkg
in
Expand All @@ -162,44 +202,7 @@ let classify_contents prefix only_package contents =
| _ -> set)
Fpath.Set.empty contents
in

let is_dir f =
try Sys.is_directory (Fpath.to_string f) with Sys_error _ -> false
in

let docs =
List.fold_left
(fun acc fpath ->
match Fpath.segs fpath with
| "doc" :: pkg :: "odoc-pages" :: _ :: _
when pkg_match pkg && not (is_dir Fpath.(prefix // fpath)) ->
Logs.debug (fun m -> m "Found odoc page: %a" Fpath.pp fpath);
let kind =
match Fpath.get_ext fpath with ".mld" -> `Mld | _ -> `Asset
in
let rel_path =
Fpath.rem_prefix Fpath.(v "doc" / pkg / "odoc-pages") fpath
|> Option.get
in
{ kind; file = Fpath.(prefix // fpath); rel_path } :: acc
| "doc" :: pkg :: "odoc-assets" :: _ :: _
when pkg_match pkg && not (is_dir Fpath.(prefix // fpath)) ->
Logs.debug (fun m -> m "Found odoc page: %a" Fpath.pp fpath);
let rel_path =
Fpath.rem_prefix Fpath.(v "doc" / pkg / "odoc-assets") fpath
|> Option.get
in
let rel_path = Fpath.(v "_assets" // rel_path) in
{ kind = `Asset; file = Fpath.(prefix // fpath); rel_path } :: acc
| [ "doc"; pkg; _ ]
when pkg_match pkg && not (is_dir Fpath.(prefix // fpath)) ->
Logs.debug (fun m -> m "Found other doc: %a" Fpath.pp fpath);
let rel_path = Fpath.base fpath in
{ kind = `Other; file = Fpath.(prefix // fpath); rel_path } :: acc
| _ -> acc)
[] contents
in
(libs, docs)
libs

let dune_overrides () =
let ocamlpath = Sys.getenv_opt "OCAMLPATH" in
Expand Down Expand Up @@ -243,7 +246,8 @@ let dune_overrides () =
(Util.StringSet.elements packages));
Util.StringSet.fold
(fun pkg acc ->
let libs, docs = classify_contents base (Some pkg) contents in
let libs = classify_libs base (Some pkg) contents in
let docs = classify_docs base (Some pkg) contents in
Logs.debug (fun m ->
m "pkg %s Found %d docs" pkg (List.length docs));
({ name = pkg; version = "dev" }, { libs; docs }) :: acc)
Expand All @@ -262,7 +266,8 @@ let pkg_to_dir_map () =
List.map
(fun p ->
let contents = pkg_contents p in
let libs, docs = classify_contents (Fpath.v prefix) None contents in
let libs = classify_libs (Fpath.v prefix) None contents in
let docs = classify_docs (Fpath.v prefix) None contents in
(p, { libs; docs }))
pkgs
in
Expand Down
2 changes: 2 additions & 0 deletions src/driver/opam.mli
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,8 @@ type package_of_fpath = package Fpath.map
type fpaths_of_package = (package * installed_files) list
val all_opam_packages : unit -> package list

val classify_docs : Fpath.t -> string option -> Fpath.t list -> doc_file list

val deps : string list -> package list
val pkg_to_dir_map : unit -> fpaths_of_package * package_of_fpath
val pp : Format.formatter -> package -> unit
Expand Down
Loading
Loading