diff --git a/CHANGES.md b/CHANGES.md index 10bf17bdce..ee9ffa226e 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -11,6 +11,7 @@ - Navigation for the search bar : use '/' to enter search, up and down arrows to select a result, and enter to follow the selected link. (@EmileTrotignon, #1088) - OCaml 5.2.0 compatibility (@Octachron, #1094, #1112) +- New driver package (@jonludlam, #1121) ### Changed diff --git a/odoc-driver.opam b/odoc-driver.opam new file mode 100644 index 0000000000..5c4cff6772 --- /dev/null +++ b/odoc-driver.opam @@ -0,0 +1,59 @@ +opam-version: "2.0" + +version: "dev" +homepage: "https://github.com/ocaml/odoc" +doc: "https://ocaml.github.io/odoc/" +bug-reports: "https://github.com/ocaml/odoc/issues" +license: "ISC" + +maintainer: [ + "Daniel Bünzli " + "Jon Ludlam " + "Jules Aguillon " + "Paul-Elliot Anglès d'Auriac " +] +authors: [ + "Anton Bachin " + "Daniel Bünzli " + "David Sheets " + "Jon Ludlam " + "Jules Aguillon " + "Leo White " + "Lubega Simon " + "Paul-Elliot Anglès d'Auriac " + "Thomas Refis " +] +dev-repo: "git+https://github.com/ocaml/odoc.git" + +synopsis: "OCaml Documentation Generator - Driver" +description: """ +The driver is a sample implementation of a tool to drive odoc to generate +documentation for installed packages. +""" + + +depends: [ + "odoc" {= version} + "bos" + "fpath" + "yojson" + "ocamlfind" + "opam-format" + "logs" + "eio_main" +] + +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] diff --git a/src/.ocamlformat-ignore b/src/.ocamlformat-ignore index 74ace4d1d5..efc536e934 100644 --- a/src/.ocamlformat-ignore +++ b/src/.ocamlformat-ignore @@ -13,4 +13,5 @@ syntax_highlighter/syntax_highlighter.ml model/*.cppo.ml html_support_files/*.ml xref2/shape_tools.* +odoc/classify.cppo.ml diff --git a/src/driver/compile.ml b/src/driver/compile.ml new file mode 100644 index 0000000000..c2d54e3fdf --- /dev/null +++ b/src/driver/compile.ml @@ -0,0 +1,161 @@ +(* compile *) + +type ty = Module of Packages.modulety | Mld of Packages.mld + +type compiled = { + m : ty; + output_dir : Fpath.t; + output_file : Fpath.t; + include_dirs : Fpath.Set.t; + impl : (Fpath.t * Fpath.t) option; +} + +let mk_byhash (pkgs : Packages.t Util.StringMap.t) = + Util.StringMap.fold + (fun _pkg_name pkg acc -> + List.fold_left + (fun acc (lib : Packages.libty) -> + List.fold_left + (fun acc (m : Packages.modulety) -> + Util.StringMap.add m.m_intf.mif_hash m acc) + acc lib.modules) + acc pkg.Packages.libraries) + pkgs Util.StringMap.empty + +open Eio.Std + +let compile env all = + let hashes = mk_byhash all in + let tbl = Hashtbl.create 10 in + let output_dir = Fpath.v "_odoc" in + + let compile_one compile_other hash = + match Util.StringMap.find_opt hash hashes with + | None -> + Logs.debug (fun m -> m "Error locating hash: %s" hash); + Error Not_found + | Some modty -> + let deps = modty.m_intf.mif_deps in + let output_file = Fpath.(output_dir // modty.m_intf.mif_odoc_file) in + let fibers = + Fiber.List.map + (fun (n, h) -> + match compile_other h with + | Ok r -> Some r + | Error _exn -> + Logs.debug (fun m -> m "Missing module %s (hash %s)" n h); + None) + deps + in + let includes = + List.fold_left + (fun acc opt -> + match opt with + | Some s -> Fpath.(Set.add s.output_dir acc) + | _ -> acc) + Fpath.Set.empty fibers + in + let includes = Fpath.Set.add output_dir includes in + let impl = + match modty.m_impl with + | Some impl -> ( + match impl.mip_src_info with + | Some si -> + let output_file = Fpath.(output_dir // impl.mip_odoc_file) in + Odoc.compile_impl env output_dir impl.mip_path includes + impl.mip_parent_id si.src_id; + Some (output_file, si.src_path) + | None -> None) + | None -> None + in + + Odoc.compile env output_dir modty.m_intf.mif_path includes + modty.m_intf.mif_parent_id; + let output_dir = Fpath.split_base output_file |> fst in + Ok + { + m = Module modty; + output_dir; + output_file; + include_dirs = includes; + impl; + } + in + + let rec compile : string -> (compiled, exn) Result.t = + fun hash -> + match Hashtbl.find_opt tbl hash with + | Some p -> Promise.await_exn p + | None -> + let p, r = Promise.create () in + Hashtbl.add tbl hash p; + let result = compile_one compile hash in + Promise.resolve_ok r result; + result + in + let mods = + Util.StringMap.fold + (fun hash modty acc -> + match compile hash with + | Error exn -> + Logs.err (fun m -> + m "Error compiling module %s" modty.Packages.m_name); + raise exn + | Ok x -> x :: acc) + hashes [] + in + Util.StringMap.fold + (fun _ (pkg : Packages.t) acc -> + Logs.debug (fun m -> + m "Package %s mlds: [%a]" pkg.name + Fmt.(list ~sep:sp Packages.pp_mld) + pkg.mlds); + List.fold_left + (fun acc (mld : Packages.mld) -> + let output_file = Fpath.(output_dir // mld.Packages.mld_odoc_file) in + let odoc_output_dir = Fpath.split_base output_file |> fst in + Odoc.compile env output_dir mld.mld_path Fpath.Set.empty + mld.mld_parent_id; + let include_dirs = + List.map (fun f -> Fpath.(output_dir // f)) mld.mld_deps + |> Fpath.Set.of_list + in + let include_dirs = Fpath.Set.add odoc_output_dir include_dirs in + { m = Mld mld; output_dir; output_file; include_dirs; impl = None } + :: acc) + acc pkg.mlds) + all mods + +type linked = { output_file : Fpath.t; src : Fpath.t option } + +let link : _ -> compiled list -> _ = + fun env compiled -> + let link : compiled -> linked list = + fun c -> + let include_dirs = Fpath.Set.add c.output_dir c.include_dirs in + let impl = + match c.impl with + | Some (x, y) -> + Logs.debug (fun m -> m "Linking impl: %a" Fpath.pp x); + Odoc.link env x include_dirs; + [ { output_file = Fpath.(set_ext "odocl" x); src = Some y } ] + | None -> [] + in + match c.m with + | Module m when m.m_hidden -> + Logs.debug (fun m -> m "not linking %a" Fpath.pp c.output_file); + impl + | _ -> + Logs.debug (fun m -> m "linking %a" Fpath.pp c.output_file); + Odoc.link env c.output_file include_dirs; + { output_file = Fpath.(set_ext "odocl" c.output_file); src = None } + :: impl + in + Fiber.List.map link compiled |> List.concat + +let html_generate : _ -> linked list -> _ = + fun env linked -> + let html_generate : linked -> unit = + fun l -> Odoc.html_generate env l.output_file l.src + in + Fiber.List.iter html_generate linked diff --git a/src/driver/dune b/src/driver/dune new file mode 100644 index 0000000000..cc7f7f2bd8 --- /dev/null +++ b/src/driver/dune @@ -0,0 +1,4 @@ +(executable + (public_name odoc_driver) + (package odoc-driver) + (libraries bos fpath yojson findlib opam-format logs logs.fmt eio_main)) diff --git a/src/driver/indexes.ml b/src/driver/indexes.ml new file mode 100644 index 0000000000..fcb70630c6 --- /dev/null +++ b/src/driver/indexes.ml @@ -0,0 +1,7 @@ +let package fmt (pkg : Packages.t) = + Format.fprintf fmt "{0 Package %s}\n" pkg.name; + Format.fprintf fmt "{1 Libraries}\n"; + List.iter + (fun (lib : Packages.libty) -> + Format.fprintf fmt "{2 %s}\n" lib.archive_name) + pkg.libraries diff --git a/src/driver/ocamlfind.ml b/src/driver/ocamlfind.ml new file mode 100644 index 0000000000..50eb3f2b36 --- /dev/null +++ b/src/driver/ocamlfind.ml @@ -0,0 +1,71 @@ +module StringSet = Set.Make (String) +module StringMap = Map.Make (String) + +let package_to_dir_map () = + Findlib.init (); + let packages = Fl_package_base.list_packages () in + List.map + (fun pkg_name -> + let dir = (Fl_package_base.query pkg_name).package_dir in + (pkg_name, dir)) + packages + +let get_dir lib = + try + Findlib.init (); + Fl_package_base.query lib |> fun x -> + Ok Fpath.(v x.package_dir |> to_dir_path) + with e -> + Printf.eprintf "Error: %s\n" (Printexc.to_string e); + Error (`Msg "Error getting directory") + +let top_libraries () = + Findlib.init (); + let packages = Fl_package_base.list_packages () in + List.fold_left + (fun acc lib -> + let package = String.split_on_char '.' lib |> List.hd in + StringSet.add package acc) + StringSet.empty packages + +let archives pkg = + Findlib.init (); + let package = Fl_package_base.query pkg in + let get_1 preds = + try + [ + Fl_metascanner.lookup "archive" preds + package.Fl_package_base.package_defs; + ] + with _ -> [] + in + match pkg with + | "stdlib" -> [ "stdlib.cma"; "stdlib.cmxa" ] + | _ -> + get_1 [ "native" ] @ get_1 [ "byte" ] + |> List.filter (fun x -> String.length x > 0) + +let sub_libraries top = + Findlib.init (); + let packages = Fl_package_base.list_packages () in + List.fold_left + (fun acc lib -> + let package = String.split_on_char '.' lib |> List.hd in + if package = top then StringSet.add lib acc else acc) + StringSet.empty packages + |> StringSet.elements + +let dir_to_package_map () = + let package_to_dir = package_to_dir_map () in + List.fold_left + (fun map (pkg_name, dir) -> + StringMap.update dir + (function None -> Some [ pkg_name ] | Some l -> Some (pkg_name :: l)) + map) + StringMap.empty package_to_dir + +let deps pkgs = + try + let packages = Fl_package_base.requires_deeply ~preds:[] pkgs in + Ok packages + with e -> Error (`Msg (Printexc.to_string e)) diff --git a/src/driver/ocamlobjinfo.ml b/src/driver/ocamlobjinfo.ml new file mode 100644 index 0000000000..8149c0d83c --- /dev/null +++ b/src/driver/ocamlobjinfo.ml @@ -0,0 +1,46 @@ +(* ocamlobjinfo *) + +open Bos +let ocamlobjinfo = Cmd.v "ocamlobjinfo" + +let source_possibilities file = + let default = [ file ] in + let generated = + if Astring.String.is_suffix ~affix:"-gen" file then + let pos = String.length file - 4 in + [ Astring.String.take ~max:pos file ] + else [] + in + default @ generated + +let get_source env file = + let cmd = Cmd.(ocamlobjinfo % p file) in + let lines = Run.run env cmd in + let f = + List.filter_map + (fun line -> + let affix = "Source file: " in + if Astring.String.is_prefix ~affix line then + let name = + String.sub line (String.length affix) + (String.length line - String.length affix) + in + let name = Fpath.(filename (v name)) in + let dir, _ = Fpath.split_base file in + let possibilities = + List.map + (fun poss -> Fpath.(dir / poss)) + (source_possibilities name) + in + List.find_opt + (fun f -> Sys.file_exists (Fpath.to_string f)) + possibilities + else None) + lines + in + match f with + | [] -> None + | x :: _ :: _ -> + Logs.warn (fun m -> m "Multiple source files found for %a" Fpath.pp file); + Some x + | x :: _ -> Some x diff --git a/src/driver/odoc.ml b/src/driver/odoc.ml new file mode 100644 index 0000000000..09c864f01a --- /dev/null +++ b/src/driver/odoc.ml @@ -0,0 +1,133 @@ +open Bos + +type compile_deps = { digest : Digest.t; deps : (string * Digest.t) list } + +let odoc = Cmd.v "./_build/default/src/odoc/bin/main.exe" +(* This is the just-built odoc binary *) + +let compile_output = ref [ "" ] + +let compile_src_output = ref [ "" ] + +let link_output = ref [ "" ] + +let generate_output = ref [ "" ] + +let source_tree_output = ref [ "" ] + +let add_prefixed_output cmd list prefix lines = + if List.length lines > 0 then + list := + !list + @ (Bos.Cmd.to_string cmd :: List.map (fun l -> prefix ^ ": " ^ l) lines) + +let compile_deps env f = + let cmd = Cmd.(odoc % "compile-deps" % Fpath.to_string f) in + let deps = Run.run env cmd in + let l = List.filter_map (Astring.String.cut ~sep:" ") deps in + let basename = Fpath.(basename (f |> rem_ext)) |> String.capitalize_ascii in + match List.partition (fun (n, _) -> basename = n) l with + | [ (_, digest) ], deps -> Ok { digest; deps } + | _ -> Error (`Msg "odd") + +let compile env output_dir file includes parent_id = + let open Cmd in + let includes = + Fpath.Set.fold + (fun path acc -> Cmd.(acc % "-I" % p path)) + includes Cmd.empty + in + let cmd = + odoc % "compile" % Fpath.to_string file % "--output-dir" % p output_dir + %% includes % "--enable-missing-root-warning" + in + let cmd = cmd % "--parent-id" % parent_id in + let lines = Run.run env cmd in + add_prefixed_output cmd compile_output (Fpath.to_string file) lines + +let compile_impl env output_dir file includes parent_id source_id = + let open Cmd in + let includes = + Fpath.Set.fold + (fun path acc -> Cmd.(acc % "-I" % p path)) + includes Cmd.empty + in + let cmd = + odoc % "compile-impl" % Fpath.to_string file % "--output-dir" % p output_dir + %% includes % "--enable-missing-root-warning" + in + let cmd = cmd % "--parent-id" % parent_id in + let cmd = cmd % "--source-id" % source_id in + let lines = Run.run env cmd in + add_prefixed_output cmd compile_output (Fpath.to_string file) lines + +let link env ?(ignore_output = false) file includes = + let open Cmd in + let output_file = Fpath.set_ext "odocl" file in + let includes = + Fpath.Set.fold + (fun path acc -> Cmd.(acc % "-I" % p path)) + includes Cmd.empty + in + let cmd = + odoc % "link" % p file % "-o" % p output_file %% includes + % "--enable-missing-root-warning" + in + let cmd = + if Fpath.to_string file = "stdlib.odoc" then cmd % "--open=\"\"" else cmd + in + let lines = Run.run env cmd in + if not ignore_output then + add_prefixed_output cmd link_output (Fpath.to_string file) lines + +let html_generate env ?(ignore_output = false) ?(assets = []) + ?(search_uris = []) file source = + let open Cmd in + let source = + match source with None -> empty | Some source -> v "--source" % p source + in + let assets = + List.fold_left (fun acc filename -> acc % "--asset" % filename) empty assets + in + let search_uris = + List.fold_left + (fun acc filename -> acc % "--search-uri" % p filename) + empty search_uris + in + let cmd = + odoc % "html-generate" %% source % p file %% assets %% search_uris % "-o" + % "html" % "--theme-uri" % "odoc" % "--support-uri" % "odoc" + in + let lines = Run.run env cmd in + if not ignore_output then + add_prefixed_output cmd generate_output (Fpath.to_string file) lines + +let support_files env = + let open Cmd in + let cmd = odoc % "support-files" % "-o" % "html/odoc" in + Run.run env cmd +let count_occurrences env output = + let open Cmd in + let cmd = odoc % "count-occurrences" % "-I" % "." % "-o" % p output in + Run.run env cmd + +let source_tree env ?(ignore_output = false) ~parent ~output file = + let open Cmd in + let parent = v "--parent" % ("page-\"" ^ parent ^ "\"") in + let cmd = + odoc % "source-tree" % "-I" % "." %% parent % "-o" % p output % p file + in + let lines = Run.run env cmd in + if not ignore_output then + add_prefixed_output cmd source_tree_output (Fpath.to_string file) lines + +let classify env dir = + let open Cmd in + let cmd = odoc % "classify" % p dir in + let lines = Run.run env cmd |> List.filter (fun l -> l <> "") in + List.map + (fun line -> + match String.split_on_char ' ' line with + | name :: modules -> (name, modules) + | _ -> failwith "bad classify output") + lines diff --git a/src/driver/odoc_driver.ml b/src/driver/odoc_driver.ml new file mode 100644 index 0000000000..25f44cb989 --- /dev/null +++ b/src/driver/odoc_driver.ml @@ -0,0 +1,472 @@ +(* Odoc driver *) + +(* Output hierarchy: + + //doc/ + //lib//Module/index.html + //src/... +*) + +(* open Bos + let ( >>= ) = Result.bind + let ( >>|= ) m f = m >>= fun x -> Ok (f x) + let get_ok = function Ok x -> x | Error (`Msg m) -> failwith m + let relativize p = Fpath.(v ".." // p) *) +(* +(* this driver is run from the [doc] dir *) + +let dep_libraries_core = + [ + "odoc-parser"; + "astring"; + "cmdliner"; + "fpath"; + "result"; + "tyxml"; + "fmt"; + "stdlib"; + "yojson"; + ] + +let extra_deps = + [ + "base"; + "base_bigstring"; + "base_quickcheck"; + "bin_prot"; + "camlp-streams"; + "core"; + "fieldslib"; + "int_repr"; + "ocaml-compiler-libs"; + "parsexp"; + "ppx_bench.runtime-lib"; + "ppx_compare"; + "ppx_enumerate"; + "ppx_expect"; + "ppx_expect.collector"; + "ppx_expect.common"; + "ppx_expect.config"; + "ppx_expect.config_types"; + "ppx_expect.evaluator"; + "ppx_expect.make_corrected_file"; + "ppx_expect.matcher"; + "ppx_expect.payload"; + "ppx_hash"; + "ppx_inline_test.config"; + "ppx_inline_test.runtime-lib"; + "ppx_module_timer"; + "ppx_sexp_conv"; + "ppx_stable_witness"; + "ppx_stable_witness.runtime"; + "ppx_stable_witness.stable_witness"; + "ppxlib"; + "ppxlib.ast"; + "ppxlib.astlib"; + "ppxlib.traverse_builtins"; + "sexplib"; + "sexplib0"; + "splittable_random"; + "stdio"; + "typerep"; + "variantslib"; + ] + +let dep_libraries = + match Sys.getenv_opt "ODOC_BENCHMARK" with + | Some "true" -> dep_libraries_core @ extra_deps + | _ -> dep_libraries_core + +let odoc_libraries = + [ + "odoc_xref_test"; + "odoc_xref2"; + "odoc_odoc"; + "odoc_html_support_files"; + "odoc_model_desc"; + "odoc_model"; + "odoc_manpage"; + "odoc_loader"; + "odoc_latex"; + "odoc_html"; + "odoc_document"; + "odoc_examples"; + "odoc_parser"; + "ocamlary"; + "odoc_search"; + "odoc_html_frontend"; + "odoc_json_index"; + "syntax_highlighter"; + "type_desc_to_yojson"; + ] *) + +(* let all_libraries = dep_libraries @ odoc_libraries *) + +(* let extra_docs = + [ + "interface"; + "driver"; + "parent_child_spec"; + "features"; + "odoc_for_authors"; + "dune"; + "ocamldoc_differences"; + "api_reference"; + ] *) + +(* let parents = + let add_parent p l = List.map (fun lib -> (lib, p)) l in + add_parent "deps" dep_libraries @ add_parent "odoc" odoc_libraries + + let ocamlfind = Cmd.v "ocamlfind" + + let reach t ~from = + let rec loop t from = + match (t, from) with + | a :: t, b :: from when a = b -> loop t from + | _ -> List.fold_right (fun _ acc -> ".." :: acc) from t + in + let v s = String.split_on_char '/' s in + loop (v t) (v from) |> String.concat "/" + + let relativize_path = + let pwd = Sys.getcwd () in + fun p -> reach p ~from:pwd + + let lib_path env lib = + let cmd = Cmd.(ocamlfind % "query" % lib) in + Run.run env cmd |> List.hd |> relativize_path + + let _lib_paths env = + List.fold_right (fun lib acc -> (lib, lib_path env lib) :: acc) dep_libraries [] + + let _find_units p = + OS.Dir.fold_contents ~dotfiles:true + (fun p acc -> + if List.exists (fun ext -> Fpath.has_ext ext p) [ "cmt"; "cmti"; "cmi" ] + then p :: acc + else acc) + [] (Fpath.v p) + >>|= fun paths -> + let l = List.map Fpath.rem_ext paths in + let l = + List.filter + (fun f -> + not @@ Astring.String.is_infix ~affix:"ocamldoc" (Fpath.to_string f)) + l + in + List.fold_right Fpath.Set.add l Fpath.Set.empty + + let _best_file base = + List.map (fun ext -> Fpath.add_ext ext base) [ "cmti"; "cmt"; "cmi" ] + |> List.find (fun f -> Bos.OS.File.exists f |> get_ok) + + let _is_hidden path = Astring.String.is_infix ~affix:"__" (Fpath.to_string path) + + type unit = { + file : Fpath.t; + ignore_output : bool; + source : Fpath.t option; + assets : string list; + } + + (* let odoc_source_tree = Fpath.v "srctree-source.odoc" *) + + let _source_dir_of_odoc_lib lib = + match String.split_on_char '_' lib with + | "odoc" :: s -> + let libname = Fpath.(v (String.concat "_" s)) in + Some Fpath.(v "src" // libname) + | _ -> None *) + +(* let source_files_of_odoc_module lib module_ = + let filename = + let module_ = + match Astring.String.cut ~rev:true ~sep:"__" module_ with + | None -> module_ + | Some (_, "") -> module_ + | Some (_, module_) -> module_ + in + (* ML.ml should not be renamed *) + if String.for_all (fun c -> Char.equal (Char.uppercase_ascii c) c) module_ + then module_ + else String.uncapitalize_ascii module_ + in + match source_dir_of_odoc_lib lib with + | None -> None + | Some relpath -> + let add_filename path ext = + Fpath.( / ) path filename |> Fpath.add_ext ext + in + let find_by_extension path exts = + exts + |> List.map (fun ext -> add_filename path ext) + |> List.find_opt (fun f -> Bos.OS.File.exists (relativize f) |> get_ok) + in + find_by_extension relpath [ "pp.ml"; "ml"; "ml-gen" ] *) + +(* let compile_source_tree env units = + let sources = + List.filter_map + (fun (_, _, _, file) -> Option.map Fpath.to_string file) + units + in + let source_map = Fpath.v "source.map" in + let () = Bos.OS.File.write_lines source_map sources |> get_ok in + let () = + Odoc.source_tree env ~parent:"odoc" ~output:odoc_source_tree source_map + in + { file = odoc_source_tree; ignore_output = false; source = None; assets = [] } *) + +(* let odoc_units () = + let odoc_all_unit_paths = find_units ".." |> get_ok in + List.map + (fun lib -> + Fpath.Set.fold + (fun p acc -> + if Astring.String.is_infix ~affix:lib (Fpath.to_string p) then + let impl = + let module_ = Fpath.basename p in + source_files_of_odoc_module lib module_ + in + ("odoc", lib, p, impl) :: acc + else acc) + odoc_all_unit_paths []) + odoc_libraries *) + +(* let all_units () = + let lib_units = + List.map + (fun (lib, p) -> + Fpath.Set.fold + (fun p acc -> ("deps", lib, p, None) :: acc) + (find_units p |> get_ok) + []) + lib_paths + in + odoc_units () @ lib_units |> List.flatten *) + +(* let update_api_reference_page () = + let libs = + List.sort String.compare odoc_libraries |> List.map String.capitalize_ascii + in + OS.File.with_oc + (Fpath.v "api_reference.mld") + (fun oc () -> + let pf = Printf.fprintf in + pf oc "{0 API Reference}\n\n"; + List.iter (pf oc "- {!%s}\n") libs; + Ok ()) + () + |> get_ok |> get_ok + + let search_file = "index.js" *) +(* + let compile_mlds env all_units = + update_api_reference_page (); + let mkpage x = "page-\"" ^ x ^ "\"" in + let mkmod x = "module-" ^ String.capitalize_ascii x in + let mkmld x = + let f = Fpath.(add_ext "mld" (v x)) in + if not (Bos.OS.File.exists f |> get_ok) then + Bos.OS.File.write_lines f [ Printf.sprintf "{0 %s}" x ] |> get_ok; + f + in + ignore + (Odoc.compile env (mkmld "odoc") + ("srctree-source" :: "page-deps" + :: List.map mkpage (odoc_libraries @ extra_docs))); + ignore + (Odoc.compile env (mkmld "deps") ~parent:"odoc" (List.map mkpage dep_libraries)); + let extra_odocs = + List.map + (fun p -> + ignore (Odoc.compile env (mkmld p) ~parent:"odoc" []); + "page-" ^ p ^ ".odoc") + extra_docs + in + let odocs = + List.map + (fun library -> + let parent = List.assoc library parents in + let children = + List.filter_map + (fun (_, lib, child, _) -> + if lib = library then Some (Fpath.basename child |> mkmod) + else None) + all_units + in + ignore + (Odoc.compile env (mkmld ("library_mlds/" ^ library)) ~parent children); + "page-" ^ library ^ ".odoc") + all_libraries + in + { + file = Fpath.v "page-odoc.odoc"; + ignore_output = false; + source = None; + assets = []; + } + :: List.map + (fun f -> + { file = Fpath.v f; ignore_output = false; source = None; assets = [] }) + (("page-deps.odoc" :: odocs) @ extra_odocs) + + let _compile_all env all_units = + let mld_odocs = compile_mlds env all_units in + let source_tree = compile_source_tree env all_units in + let compile_src file ~ignore_output source_args () = + match source_args with + | None -> () + | Some source_name -> + Odoc.compile_src env (Fpath.set_ext "cmt" file) ~source_name ~ignore_output + ~source_parent_file:odoc_source_tree () + in + let rec rec_compile ?impl parent lib file = + let output = Fpath.(base (set_ext "odoc" file)) in + if OS.File.exists output |> get_ok then [] + else + let deps = Odoc.compile_deps env file |> get_ok in + ignore deps.digest; + let files = + List.fold_left + (fun acc (dep_name, _digest) -> + match + List.find_opt + (fun (_, _, f, _) -> + Fpath.basename f |> String.capitalize_ascii = dep_name) + all_units + with + | None -> acc + | Some (parent, lib, dep_path, impl) -> + let file = best_file dep_path in + rec_compile ?impl parent lib file @ acc) + [] deps.deps + in + let ignore_output = parent = "deps" in + compile_src file impl ~ignore_output (); + Odoc.compile env file ~parent:lib ~ignore_output []; + { file = output; ignore_output; source = impl; assets = [] } :: files + in + source_tree + :: List.fold_left + (fun acc (parent, lib, dep, impl) -> + acc @ rec_compile ?impl parent lib (best_file dep)) + [] all_units + @ mld_odocs *) + +(* let src_file file = + let fdir, fname = Fpath.split_base file in + let fname = Fpath.v ("src-" ^ Fpath.to_string fname) in + Fpath.( // ) fdir fname + let _link_all env odoc_files = + List.map + (fun ({ file = odoc_file; ignore_output; source; _ } as unit) -> + if Option.is_some source then + ignore (Odoc.link env ~ignore_output (src_file odoc_file)); + ignore (Odoc.link env ~ignore_output odoc_file); + { unit with file = Fpath.set_ext "odocl" odoc_file }) + odoc_files + + let _generate_all env odocl_files = + let search_uris = [ Fpath.v "minisearch.js"; Fpath.v "index.js" ] in + List.iter + (fun { file; ignore_output = _; source; assets } -> + ignore (Odoc.html_generate env ~assets ~search_uris file None); + match source with + | None -> () + | Some source -> + ignore (Odoc.html_generate env (src_file file) (Some (relativize source)))) + odocl_files; + Odoc.support_files env *) + +(* let index_generate ?(ignore_output = false) () = + let open Cmd in + let files = + OS.Dir.contents (Fpath.v ".") + |> get_ok + |> List.filter (Fpath.has_ext "odocl") + |> List.filter (fun p -> + String.starts_with ~prefix:"src-" (Fpath.filename p)) + |> List.filter (fun p -> not (is_hidden p)) + |> List.map Fpath.to_string + in + let index_map = Fpath.v "index.map" in + let () = Bos.OS.File.write_lines index_map files |> get_ok in + let cmd = + Odoc.odoc % "compile-index" % "-o" % "html/index.json" % "--file-list" + % p index_map + in + let lines = Run.run cmd in + if not ignore_output then + Odoc.add_prefixed_output cmd Odoc.generate_output "index compilation" lines *) + +(* let _js_index () = + let index = Bos.OS.File.read Fpath.(v "html" / "index.json") |> get_ok in + Bos.OS.File.writef (Fpath.v search_file) + {| + let documents = + %s + ; + + let miniSearch = new MiniSearch({ + fields: ['id', 'doc', 'entry_id'], // fields to index for full-text search + storeFields: ['display'], // fields to return with search results + idField: 'entry_id', + extractField: (document, fieldName) => { + if (fieldName === 'id') { + return document.id.map(e => e.kind + "-" + e.name).join('.') + } + return document[fieldName] + } + }) + + + // Use a unique id since some entries' id are not unique (type extension or + // standalone doc comments for instance) + documents.forEach((entry,i) => entry.entry_id = i) + miniSearch.addAll(documents); + + onmessage = (m) => { + let query = m.data; + let result = miniSearch.search(query); + postMessage(result.slice(0,200).map(a => a.display)); + } + |} + index + |> get_ok; + Bos.OS.Cmd.run Bos.Cmd.(v "cp" % search_file % "html/") |> get_ok; + Bos.OS.Cmd.run Bos.Cmd.(v "cp" % "minisearch.js" % "html/") |> get_ok *) + +let _ = + Eio_main.run @@ fun env -> + Logs.set_level (Some Logs.Debug); + Logs.set_reporter (Logs_fmt.reporter ()); + let libs = Ocamlfind.sub_libraries "core" in + let all = Packages.of_libs env libs in + let compiled = Compile.compile env all in + let linked = Compile.link env compiled in + let _ = Compile.html_generate env linked in + + let indexes = Util.StringMap.map (fun _i pkg -> Indexes.package pkg) all in + ignore indexes; + (* let map = Ocamlfind.package_to_dir_map () in + let _dirs = List.map (fun lib -> List.assoc lib map) deps in + + + let (_, lib_to_pkg_map) = Opam.pkg_to_dir_map () in + Opam.StringMap.iter (fun k v -> + if k <> v.Opam.name then + Format.printf "%s -> %a\n" k Opam.pp v) lib_to_pkg_map; + List.iter (fun dep -> Format.printf "%s\n%!" dep) deps; + ignore (exit 0); *) + (* let all_units = all_units () in + let compiled = compile_all all_units in + let linked = link_all compiled in + let () = index_generate () in + (* let _ = js_index () in *) + ignore js_index; + let _ = Odoc.count_occurrences (Fpath.v "occurrences-from-odoc.odoc") in + ignore (generate_all linked); + let _ = Stats.bench_results () in *) + () diff --git a/src/driver/opam.ml b/src/driver/opam.ml new file mode 100644 index 0000000000..31dfb44e61 --- /dev/null +++ b/src/driver/opam.ml @@ -0,0 +1,157 @@ +open Bos + +let opam = Cmd.v "opam" +let switch = ref None +let prefix = ref None + +type package = { name : string; version : string } + +let pp fmt p = Format.fprintf fmt "%s.%s" p.name p.version + +let rec get_switch () = + match !switch with + | None -> + let cur_switch = + Util.lines_of_process Cmd.(opam % "switch" % "show") |> List.hd + in + switch := Some cur_switch; + get_switch () + | Some s -> s + +let prefix () = + match !prefix with + | Some p -> p + | None -> + let p = + Util.lines_of_process + Cmd.(opam % "var" % "--switch" % get_switch () % "prefix") + |> List.hd + in + prefix := Some p; + p + +let deps_of_opam_result line = + match Astring.String.fields ~empty:false line with + | [ name; version ] -> [ { name; version } ] + | _ -> [] + +let all_opam_packages () = + Util.lines_of_process + Cmd.( + opam % "list" % "--switch" % get_switch () % "--columns=name,version" + % "--color=never" % "--short") + |> List.map deps_of_opam_result + |> List.flatten + +let pkg_contents { name; _ } = + let prefix = Fpath.v (prefix ()) in + let changes_file = + Format.asprintf "%a/.opam-switch/install/%s.changes" Fpath.pp prefix name + in + let file = OpamFilename.raw changes_file in + let filename = + OpamFile.make @@ OpamFilename.raw @@ Filename.basename changes_file + in + let changed = + OpamFilename.with_contents + (fun str -> + OpamFile.Changes.read_from_string ~filename + @@ + (* Field [opam-version] is invalid in [*.changes] files, displaying a warning. *) + if OpamStd.String.starts_with ~prefix:"opam-version" str then + match OpamStd.String.cut_at str '\n' with + | Some (_, str) -> str + | None -> assert false + else str) + file + in + let added = + OpamStd.String.Map.fold + (fun file x acc -> + match x with + | OpamDirTrack.Added _ -> ( + try + if not @@ Sys.is_directory Fpath.(to_string (prefix // v file)) + then file :: acc + else acc + with _ -> + acc + (* dose (and maybe others) sometimes creates a symlink to something that doesn't exist *) + ) + | _ -> acc) + changed [] + in + List.map Fpath.v added + +let opam_file { name; version } = + let prefix = Fpath.v (prefix ()) in + let opam_file = + Format.asprintf "%a/.opam-switch/packages/%s.%s/opam" Fpath.pp prefix name + version + in + try + let ic = open_in opam_file in + let lines = Util.lines_of_channel ic in + close_in ic; + Some lines + with _ -> None + +let pkg_to_dir_map () = + let pkgs = all_opam_packages () in + let prefix = prefix () in + let pkg_content = + List.map + (fun p -> + let contents = pkg_contents p in + let libs = + List.fold_left + (fun set fpath -> + match Fpath.segs fpath with + | "lib" :: "stublibs" :: _ -> set + | "lib" :: _ :: _ :: _ when Fpath.has_ext ".cmi" fpath -> + Fpath.Set.add + Fpath.(v prefix // fpath |> split_base |> fst) + set + | _ -> set) + Fpath.Set.empty contents + in + let odoc_pages, other_docs = + List.fold_left + (fun (odoc_pages, others) fpath -> + match Fpath.segs fpath with + | "doc" :: _pkg :: "odoc-pages" :: _ -> + Logs.debug (fun m -> m "Found odoc page: %a" Fpath.pp fpath); + + (Fpath.Set.add Fpath.(v prefix // fpath) odoc_pages, others) + | "doc" :: _ -> + Logs.debug (fun m -> m "Found other doc: %a" Fpath.pp fpath); + (odoc_pages, Fpath.Set.add Fpath.(v prefix // fpath) others) + | _ -> (odoc_pages, others)) + Fpath.Set.(empty, empty) + contents + in + Logs.debug (fun m -> + m "Found %d odoc pages, %d other docs" + (Fpath.Set.cardinal odoc_pages) + (Fpath.Set.cardinal other_docs)); + (p, libs, odoc_pages, other_docs)) + pkgs + in + let map = + List.fold_left + (fun map (p, content, _, _) -> + Fpath.Set.fold + (fun dir map -> + Fpath.Map.update dir + (function + | None -> Some p + | Some x -> + Logs.debug (fun m -> + m "Multiple packages (%a,%a) found for dir %a" pp x pp p + Fpath.pp dir); + Some p) + map) + content map) + Fpath.Map.empty pkg_content + in + (pkg_content, map) diff --git a/src/driver/packages.ml b/src/driver/packages.ml new file mode 100644 index 0000000000..1574f26674 --- /dev/null +++ b/src/driver/packages.ml @@ -0,0 +1,311 @@ +(* Packages *) + +type ty = Cmti | Cmt | Cmi + +type dep = string * string + +type intf = { + mif_odoc_file : Fpath.t; + mif_odocl_file : Fpath.t; + mif_parent_id : string; + mif_hash : string; + mif_path : Fpath.t; + mif_deps : dep list; +} + +let pp_intf fmt i = Format.fprintf fmt "intf: %a" Fpath.pp i.mif_path + +type src_info = { src_path : Fpath.t; src_id : string } + +type impl = { + mip_odoc_file : Fpath.t; + mip_odocl_file : Fpath.t; + mip_parent_id : string; + mip_path : Fpath.t; + mip_src_info : src_info option; +} + +let pp_impl fmt i = Format.fprintf fmt "impl: %a" Fpath.pp i.mip_path + +type modulety = { + m_name : string; + m_intf : intf; + m_impl : impl option; + m_hidden : bool; +} + +type mld = { + mld_odoc_file : Fpath.t; + mld_odocl_file : Fpath.t; + mld_parent_id : string; + mld_path : Fpath.t; + mld_deps : Fpath.t list; +} + +let pp_mld fmt m = Format.fprintf fmt "%a" Fpath.pp m.mld_path + +type libty = { + lib_name : string; + dir : Fpath.t; + odoc_dir : Fpath.t; + archive_name : string; + modules : modulety list; +} + +type t = { + name : string; + version : string; + libraries : libty list; + mlds : mld list; + other_docs : Fpath.Set.t; +} + +module Module = struct + type t = modulety + + let pp ppf (t : t) = + Fmt.pf ppf "name: %s@.intf: %a@.impl: %a@.hidden: %b@." t.m_name Fpath.pp + t.m_intf.mif_path (Fmt.option pp_impl) t.m_impl t.m_hidden + + let is_hidden name = Astring.String.is_infix ~affix:"__" name + + let vs env pkg_name lib_name dir modules = + let mk m_name = + let exists ext = + let p = + Fpath.(dir // add_ext ext (v (String.uncapitalize_ascii m_name))) + in + let upperP = + Fpath.(dir // add_ext ext (v (String.capitalize_ascii m_name))) + in + Logs.debug (fun m -> + m "Checking %a (then %a)" Fpath.pp p Fpath.pp upperP); + match Bos.OS.File.exists p with + | Ok true -> Some p + | _ -> ( + match Bos.OS.File.exists upperP with + | Ok true -> Some upperP + | _ -> None) + in + let mk_intf mif_path = + let mif_parent_id = Printf.sprintf "%s/lib/%s" pkg_name lib_name in + let mif_odoc_file = + Fpath.( + v mif_parent_id + // set_ext "odoc" (v (String.uncapitalize_ascii m_name))) + in + let mif_odocl_file = Fpath.(set_ext "odocl" mif_odoc_file) in + match Odoc.compile_deps env mif_path with + | Ok { digest; deps } -> + { + mif_odoc_file; + mif_odocl_file; + mif_parent_id; + mif_hash = digest; + mif_path; + mif_deps = deps; + } + | Error _ -> failwith "bad deps" + in + let mk_impl mip_path = + let mip_parent_id = Printf.sprintf "%s/lib/%s" pkg_name lib_name in + let mip_odoc_file = + Fpath.( + v mip_parent_id + // add_ext "odoc" (v ("impl-" ^ String.uncapitalize_ascii m_name))) + in + let mip_odocl_file = Fpath.(set_ext "odocl" mip_odoc_file) in + let mip_src_info = + match Ocamlobjinfo.get_source env mip_path with + | None -> + Logs.debug (fun m -> m "No source found for module %s" m_name); + None + | Some src_path -> + Logs.debug (fun m -> + m "Found source file %a for %s" Fpath.pp src_path m_name); + let src_name = Fpath.filename src_path in + let src_id = + Printf.sprintf "%s/src/%s/%s" pkg_name lib_name src_name + in + Some { src_path; src_id } + in + { mip_odoc_file; mip_odocl_file; mip_parent_id; mip_src_info; mip_path } + in + let state = (exists "cmt", exists "cmti") in + + let m_hidden = is_hidden m_name in + let m_intf, m_impl = + match state with + | Some cmt, Some cmti -> (mk_intf cmti, Some (mk_impl cmt)) + | Some cmt, None -> (mk_intf cmt, Some (mk_impl cmt)) + | None, Some cmti -> (mk_intf cmti, None) + | None, None -> + Logs.err (fun m -> m "No files for module: %s" m_name); + failwith "no files" + in + { m_name; m_intf; m_impl; m_hidden } + in + + List.map mk modules +end + +module Lib = struct + type t = libty + + let v env libname_of_archive pkg_name dir = + try + Logs.debug (fun m -> + m "Classifying dir %a for package %s" Fpath.pp dir pkg_name); + let results = Odoc.classify env dir in + List.map + (fun (archive_name, modules) -> + let lib_name = Util.StringMap.find archive_name libname_of_archive in + let modules = Module.vs env pkg_name lib_name dir modules in + let odoc_dir = + List.hd modules |> fun m -> + m.m_intf.mif_odoc_file |> Fpath.split_base |> fst + in + { lib_name; dir; odoc_dir; archive_name; modules }) + results + with e -> + Logs.err (fun m -> + m "Error classifying %a (%s)" Fpath.pp dir (Printexc.to_string e)); + [] + + let pp ppf t = + Fmt.pf ppf "path: %a archive: %a modules: [@[@,%a@]@,]" Fpath.pp + t.dir Fmt.string t.archive_name + Fmt.(list ~sep:sp Module.pp) + t.modules +end + +let pp ppf t = + Fmt.pf ppf "name: %s@.version: %s@.libraries: [@[@,%a@]@,]" t.name + t.version + Fmt.(list ~sep:sp Lib.pp) + t.libraries + +let of_libs env libs = + match Ocamlfind.deps libs with + | Error (`Msg e) -> + Logs.err (fun m -> + m "Error finding dependencies of libraries [%s]: %s" + (String.concat ", " libs) e); + Util.StringMap.empty + | Ok all_libs -> + let all_libs = "stdlib" :: all_libs in + Logs.debug (fun m -> + m "Libraries to document: [%a]" Fmt.(list ~sep:sp string) all_libs); + let dirs' = + List.filter_map + (fun lib -> + match Ocamlfind.get_dir lib with + | Error _ -> + Logs.debug (fun m -> m "No dir for library %s" lib); + None + | Ok p -> + let archives = Ocamlfind.archives lib in + let archives = + List.map + (fun x -> + try Filename.chop_extension x + with e -> + Logs.err (fun m -> m "Can't chop extension from %s" x); + raise e) + archives + in + let archives = Util.StringSet.(of_list archives) in + Some (lib, p, archives)) + all_libs + in + let map, rmap = Opam.pkg_to_dir_map () in + let dirs = + List.fold_left + (fun set (_lib, p, archives) -> + Fpath.Map.update p + (function + | Some set -> Some (Util.StringSet.union set archives) + | None -> Some archives) + set) + Fpath.Map.empty dirs' + in + let libname_of_archive = + List.fold_left + (fun map (lib, _, archives) -> + match Util.StringSet.elements archives with + | [] -> map + | [ archive ] -> + Util.StringMap.update archive + (function None -> Some lib | Some _ -> assert false) + map + | xs -> + Logs.err (fun m -> + m "multiple archives detected: [%a]" + Fmt.(list ~sep:sp string) + xs); + assert false) + Util.StringMap.empty dirs' + in + ignore libname_of_archive; + let mk_mlds _env pkg_name libraries odoc_pages = + Fpath.Set.fold + (fun mld_path acc -> + let mld_parent_id = Printf.sprintf "%s/doc" pkg_name in + let page_name = Fpath.(rem_ext mld_path |> filename) in + let odoc_file = + Fpath.(v mld_parent_id / ("page-" ^ page_name ^ ".odoc")) + in + let odocl_file = Fpath.(set_ext "odocl" odoc_file) in + let mld_deps = List.map (fun l -> l.odoc_dir) libraries in + { + mld_odoc_file = odoc_file; + mld_odocl_file = odocl_file; + mld_parent_id; + mld_path; + mld_deps; + } + :: acc) + odoc_pages [] + in + Fpath.Map.fold + (fun dir archives acc -> + match Fpath.Map.find dir rmap with + | None -> + Logs.debug (fun m -> m "No package for dir %a\n%!" Fpath.pp dir); + acc + | Some pkg -> + let libraries = Lib.v env libname_of_archive pkg.name dir in + let libraries = + List.filter + (fun l -> Util.StringSet.mem l.archive_name archives) + libraries + in + let pkg', _, odoc_pages, other_docs = + List.find + (fun (pkg', _, _, _) -> + Logs.debug (fun m -> + m "Checking %s against %s" pkg.Opam.name pkg'.Opam.name); + pkg = pkg') + map + in + let mlds = mk_mlds env pkg'.name libraries odoc_pages in + Logs.debug (fun m -> + m "%d mlds for package %s (from %d odoc_pages)" + (List.length mlds) pkg.name + (Fpath.Set.cardinal odoc_pages)); + + Util.StringMap.update pkg.name + (function + | Some pkg -> + Some { pkg with libraries = libraries @ pkg.libraries } + | None -> + Some + { + name = pkg.name; + version = pkg.version; + libraries; + mlds; + other_docs; + }) + acc) + dirs Util.StringMap.empty diff --git a/src/driver/run.ml b/src/driver/run.ml new file mode 100644 index 0000000000..3a9b434801 --- /dev/null +++ b/src/driver/run.ml @@ -0,0 +1,61 @@ +let instrument = false + +open Bos + +let instrument_dir = + lazy + (let dir = Fpath.v "landmarks" in + OS.Dir.delete dir |> Result.get_ok; + OS.Dir.create dir |> Result.get_ok |> ignore; + dir) + +type executed_command = { + cmd : string list; + time : float; (** Running time in seconds. *) + output_file : Fpath.t option; +} + +(* Environment variables passed to commands. *) + +(* Record the commands executed, their running time and optionally the path to + the produced file. *) +let commands = ref [] + +(** Return the list of executed commands where the first argument was [cmd]. *) +let run env cmd = + let cmd = Bos.Cmd.to_list cmd in + let proc_mgr = Eio.Stdenv.process_mgr env in + let t_start = Unix.gettimeofday () in + let env = + let env = OS.Env.current () |> Result.get_ok in + env + in + let env = + Astring.String.Map.fold + (fun k v env -> Astring.String.concat [ k; "="; v ] :: env) + env [] + |> Array.of_list + in + Logs.debug (fun m -> m "Running cmd %a" Fmt.(list ~sep:sp string) cmd); + let r = Eio.Process.parse_out proc_mgr Eio.Buf_read.take_all ~env cmd in + Logs.debug (fun m -> + m "Finished running cmd %a" Fmt.(list ~sep:sp string) cmd); + let t_end = Unix.gettimeofday () in + let r = String.split_on_char '\n' r in + let time = t_end -. t_start in + commands := { cmd; time; output_file = None } :: !commands; + r + +(** Print an executed command and its time. *) + +let filter_commands cmd = + match + List.filter + (fun c -> match c.cmd with _ :: cmd' :: _ -> cmd = cmd' | _ -> false) + !commands + with + | [] -> failwith ("No commands run for " ^ cmd) + | _ :: _ as cmds -> cmds + +let print_cmd c = + Printf.printf "[%4.2f] $ %s\n" c.time (String.concat " " c.cmd) diff --git a/src/driver/stats.ml b/src/driver/stats.ml new file mode 100644 index 0000000000..a54a2d3cd0 --- /dev/null +++ b/src/driver/stats.ml @@ -0,0 +1,151 @@ +(* Stats *) + +(** Returns the [k] commands that took the most time for a given subcommand. *) + +let k_longest_commands cmd k = + let open Run in + filter_commands cmd + |> List.sort (fun a b -> Float.compare b.time a.time) + |> List.filteri (fun i _ -> i < k) + +let dump () = + let open Run in + List.iter print_cmd (List.rev !commands); + List.iter print_cmd (k_longest_commands "compile" 5); + List.iter print_cmd (k_longest_commands "link" 5); + List.iter print_cmd (k_longest_commands "html-generate" 5) + +let rec compute_min_max_avg min_ max_ total count = function + | [] -> (min_, max_, total /. float count, count) + | hd :: tl -> + compute_min_max_avg (min min_ hd) (max max_ hd) (total +. hd) (count + 1) + tl + +let compute_min_max_avg = function + | [] -> assert false + | hd :: tl -> compute_min_max_avg hd hd hd 1 tl + +let compute_metric_int prefix suffix description values = + let min, max, avg, count = compute_min_max_avg values in + let min = int_of_float min in + let max = int_of_float max in + let avg = int_of_float avg in + [ + `Assoc + [ + ("name", `String (prefix ^ "-total-" ^ suffix)); + ("value", `Int count); + ("description", `String ("Number of " ^ description)); + ]; + `Assoc + [ + ("name", `String (prefix ^ "-size-" ^ suffix)); + ( "value", + `Assoc [ ("min", `Int min); ("max", `Int max); ("avg", `Int avg) ] ); + ("units", `String "b"); + ("description", `String ("Size of " ^ description)); + ("trend", `String "lower-is-better"); + ]; + ] + +let compute_metric_cmd cmd = + let open Run in + let cmds = filter_commands cmd in + let times = List.map (fun c -> c.Run.time) cmds in + let min, max, avg, count = compute_min_max_avg times in + [ + `Assoc + [ + ("name", `String ("total-" ^ cmd)); + ("value", `Int count); + ("description", `String ("Number of time 'odoc " ^ cmd ^ "' has run.")); + ]; + `Assoc + [ + ("name", `String ("time-" ^ cmd)); + ( "value", + `Assoc + [ ("min", `Float min); ("max", `Float max); ("avg", `Float avg) ] ); + ("units", `String "s"); + ("description", `String ("Time taken by 'odoc " ^ cmd ^ "'")); + ("trend", `String "lower-is-better"); + ]; + ] + +(** Analyze the size of files produced by a command. *) +let compute_produced_cmd cmd = + let output_file_size c = + match c.Run.output_file with + | Some f -> ( + match Bos.OS.Path.stat f with + | Ok st -> Some (float st.Unix.st_size) + | Error _ -> None) + | None -> None + in + let sizes = List.filter_map output_file_size (Run.filter_commands cmd) in + compute_metric_int "produced" cmd + ("files produced by 'odoc " ^ cmd ^ "'") + sizes + +(** Analyze the size of files outputed to the given directory. *) +let compute_produced_tree cmd dir = + let acc_file_sizes path acc = + match Bos.OS.Path.stat path with + | Ok st -> float st.Unix.st_size :: acc + | Error _ -> acc + in + Bos.OS.Dir.fold_contents ~dotfiles:true ~elements:`Files acc_file_sizes [] + (Fpath.v dir) + |> Result.get_ok + |> compute_metric_int "produced" cmd ("files produced by 'odoc " ^ cmd ^ "'") + +(** Analyze the running time of the slowest commands. *) +let compute_longest_cmd cmd = + let k = 5 in + let cmds = k_longest_commands cmd k in + let times = List.map (fun c -> c.Run.time) cmds in + let min, max, avg, _count = compute_min_max_avg times in + [ + `Assoc + [ + ("name", `String ("longest-" ^ cmd)); + ( "value", + `Assoc + [ ("min", `Float min); ("max", `Float max); ("avg", `Float avg) ] ); + ("units", `String "s"); + ( "description", + `String + (Printf.sprintf "Time taken by the %d longest calls to 'odoc %s'" k + cmd) ); + ("trend", `String "lower-is-better"); + ]; + ] + +let all_metrics () = + compute_metric_cmd "compile" + @ compute_metric_cmd "compile-deps" + @ compute_metric_cmd "link" + @ compute_metric_cmd "html-generate" + @ compute_longest_cmd "compile" + @ compute_longest_cmd "link" + @ compute_produced_cmd "compile" + @ compute_produced_cmd "link" + @ compute_produced_tree "html-generate" "html/" + +let bench_results () = + let result = + `Assoc + [ + ("name", `String "odoc"); + ( "results", + `List + [ + `Assoc + [ + ("name", `String "driver.mld"); + ("metrics", `List (all_metrics ())); + ]; + ] ); + ] + in + Yojson.to_file "driver-benchmarks.json" result diff --git a/src/driver/util.ml b/src/driver/util.ml new file mode 100644 index 0000000000..2fc786c226 --- /dev/null +++ b/src/driver/util.ml @@ -0,0 +1,45 @@ +open Bos + +module StringSet = Set.Make (String) +module StringMap = Map.Make (String) + +let lines_of_channel ic = + let rec inner acc = + try + let l = input_line ic in + inner (l :: acc) + with End_of_file -> List.rev acc + in + inner [] + +let lines_of_process cmd = + match OS.Cmd.(run_out ~err:err_null cmd |> to_lines) with + | Ok x -> x + | Error (`Msg e) -> failwith ("Error: " ^ e) + +let mkdir_p d = + let segs = + Fpath.segs (Fpath.normalize d) |> List.filter (fun s -> String.length s > 0) + in + let _ = + List.fold_left + (fun path seg -> + let d = Fpath.(path // v seg) in + try + Unix.mkdir (Fpath.to_string d) 0o755; + d + with + | Unix.Unix_error (Unix.EEXIST, _, _) -> d + | exn -> raise exn) + (Fpath.v ".") segs + in + () + +let write_file filename lines = + let dir = fst (Fpath.split_base filename) in + mkdir_p dir; + let oc = open_out (Fpath.to_string filename) in + List.iter (fun line -> Printf.fprintf oc "%s\n" line) lines; + close_out oc + +let cp src dst = assert (lines_of_process Cmd.(v "cp" % src % dst) = []) diff --git a/src/model/compat.cppo.ml b/src/model/compat.cppo.ml index dd0aa61c03..b5e528955b 100644 --- a/src/model/compat.cppo.ml +++ b/src/model/compat.cppo.ml @@ -272,3 +272,21 @@ let empty_map = () let shape_info_of_cmt_infos : Cmt_format.cmt_infos -> (shape * uid_to_loc) option = fun _ -> None #endif + +#if OCAML_VERSION >= (5,2,0) +let compunit_name : Cmo_format.compunit -> string = function | Compunit x -> x + +let required_compunit_names x = List.map compunit_name x.Cmo_format.cu_required_compunits + +#elif OCAML_VERSION >= (4,04,0) + +let compunit_name x = x + +let required_compunit_names x = List.map Ident.name x.Cmo_format.cu_required_globals + +#else + + let compunit_name x = x + let required_compunit_names x = List.map fst x.Cmo_format.cu_imports + +#endif diff --git a/src/odoc/bin/main.ml b/src/odoc/bin/main.ml index e91d4a8b87..4ec144c699 100644 --- a/src/odoc/bin/main.ml +++ b/src/odoc/bin/main.ml @@ -54,15 +54,6 @@ let convert_src_dir = and print = Rendering.Source.pp in Arg.conv (parse, print) -(** On top of the conversion 'string', split into segs. *) -let convert_source_name = - let parse inp = - match Arg.(conv_parser string) inp with - | Ok s -> Result.Ok (s |> Fs.File.of_string |> Fs.File.segs) - | Error _ as e -> e - and print ppf x = Format.fprintf ppf "%s" (String.concat ~sep:"/" x) in - Arg.conv (parse, print) - let handle_error = function | Result.Ok () -> () | Error (`Cli_error msg) -> @@ -182,8 +173,9 @@ end = struct in Fs.File.(set_ext ".odoc" output) - let compile hidden directories resolve_fwd_refs dst package_opt - parent_name_opt open_modules children input warnings_options = + let compile hidden directories resolve_fwd_refs dst output_dir package_opt + parent_name_opt parent_id_opt open_modules children input warnings_options + = let open Or_error in let resolver = Resolver.create ~important_digests:(not resolve_fwd_refs) ~directories @@ -192,19 +184,21 @@ end = struct let input = Fs.File.of_string input in let output = output_file ~dst ~input in let parent_cli_spec = - match (parent_name_opt, package_opt) with - | Some p, None -> Ok (Compile.CliParent p) - | None, Some p -> Ok (Compile.CliPackage p) - | None, None -> Ok Compile.CliNoparent - | Some _, Some _ -> + match (parent_name_opt, package_opt, parent_id_opt) with + | Some p, None, None -> Ok (Compile.CliParent p) + | None, Some p, None -> Ok (Compile.CliPackage p) + | None, None, Some p -> Ok (Compile.CliParentId p) + | None, None, None -> Ok Compile.CliNoparent + | _, _, _ -> Error (`Cli_error - "Either --package or --parent should be specified, not both") + "Either --package or --parent or --parent-id should be \ + specified, not a combination") in parent_cli_spec >>= fun parent_cli_spec -> Fs.Directory.mkdir_p (Fs.File.dirname output); Compile.compile ~resolver ~parent_cli_spec ~hidden ~children ~output - ~warnings_options input + ~output_dir ~warnings_options input let input = let doc = "Input $(i,.cmti), $(i,.cmt), $(i,.cmi) or $(i,.mld) file." in @@ -220,6 +214,13 @@ end = struct in Arg.(value & opt (some string) None & info ~docs ~docv:"PATH" ~doc [ "o" ]) + let output_dir = + let doc = "Output file directory. " in + Arg.( + value + & opt (some string) None + & info ~docs ~docv:"PATH" ~doc [ "output-dir" ]) + let children = let doc = "Specify the $(i,.odoc) file as a child. Can be used multiple times. \ @@ -246,6 +247,13 @@ end = struct & opt (some string) None & info ~docs ~docv:"PARENT" ~doc [ "parent" ]) in + let parent_id_opt = + let doc = "Parent id." in + Arg.( + value + & opt (some string) None + & info ~docs ~docv:"PARENT" ~doc [ "parent-id" ]) + in let resolve_fwd_refs = let doc = "Try resolving forward references." in Arg.(value & flag & info ~doc [ "r"; "resolve-fwd-refs" ]) @@ -253,8 +261,8 @@ end = struct Term.( const handle_error $ (const compile $ hidden $ odoc_file_directories $ resolve_fwd_refs $ dst - $ package_opt $ parent_opt $ open_modules $ children $ input - $ warnings_options)) + $ output_dir $ package_opt $ parent_opt $ parent_id_opt $ open_modules + $ children $ input $ warnings_options)) let info ~docs = let man = @@ -359,93 +367,68 @@ module Source_tree = struct Term.info "source-tree" ~docs ~doc end -module Compile_src = struct - let prefix = "src-" +module Compile_impl = struct + let prefix = "impl-" - let has_src_prefix input = - input |> Fs.File.basename |> Fs.File.to_string - |> Astring.String.is_prefix ~affix:prefix + let output_dir = + let doc = "Output file directory. " in + Arg.( + value + & opt (some string) None + & info ~docs ~docv:"PATH" ~doc [ "output-dir" ]) - let output_file ~output ~input = - match output with - | Some output -> output - | None -> - let output = - if not (has_src_prefix input) then - let directory = Fs.File.dirname input in - let name = input |> Fs.File.basename |> Fs.File.to_string in - let name = prefix ^ name in - Fs.File.create ~directory ~name - else input - in - Fs.File.(set_ext ".odoc" output) + let output_file output_dir parent_id input = + let name = + Fs.File.basename input |> Fpath.set_ext "odoc" |> Fs.File.to_string + |> Astring.String.Ascii.uncapitalize + in + let name = prefix ^ name in + + let dir = Fpath.(append output_dir parent_id) in + Fs.File.create + ~directory:(Fpath.to_string dir |> Fs.Directory.of_string) + ~name - let compile_source directories output source_parent_file source_path input + let compile_impl directories output_dir parent_id source_id input warnings_options = let input = Fs.File.of_string input in - let output = output_file ~output ~input in + let output_dir = + match output_dir with Some x -> Fpath.v x | None -> Fpath.v "." + in + let output = + output_file output_dir + (match parent_id with Some x -> Fpath.v x | None -> Fpath.v ".") + input + in let resolver = Resolver.create ~important_digests:true ~directories ~open_modules:[] in - Source.compile ~resolver ~source_parent_file ~source_path ~output - ~warnings_options input - - let arg_page_output = - let open Or_error in - let parse inp = - match Arg.(conv_parser string) inp with - | Ok s -> - let f = Fs.File.of_string s in - if not (Fs.File.has_ext ".odoc" f) then - Error (`Msg "Output file must have '.odoc' extension.") - else if not (has_src_prefix f) then - Error - (`Msg - (Format.sprintf "Output file must be prefixed with '%s'." prefix)) - else Ok f - | Error _ as e -> e - and print = Fpath.pp in - Arg.conv (parse, print) + Source.compile ~resolver ~source_id ~output ~warnings_options input let cmd = - let dst = - let doc = - Format.sprintf - "Output file path. Non-existing intermediate directories are \ - created. The basename must start with the prefix '%s' and extension \ - '.odoc'." - prefix - in - Arg.( - value - & opt (some arg_page_output) None - & info ~docs ~docv:"PATH" ~doc [ "o" ]) - in let input = let doc = "Input $(i,.cmt) file." in Arg.(required & pos 0 (some file) None & info ~doc ~docv:"FILE" []) in - let source_parent_file = - let doc = "The source-tree file parent of the implementation." in + let source_id = + let doc = "The id of the source file" in Arg.( required - & opt (some convert_fpath) None - & info [ "parent" ] ~doc ~docv:(Source_tree.prefix ^ "PARENT.odoc")) + & opt (some string) None + & info [ "source-id" ] ~doc ~docv:"/path/to/source.ml") in - let source_path = - let doc = - "The relative path of the source file. This is used to place the \ - source file within the parent source tree." - in + let parent_id = + let doc = "The parent id of the implementation" in Arg.( - required - & opt (some convert_source_name) None - & info [ "source-path" ] ~doc ~docv:"NAME") + value + & opt (some string) None + & info [ "parent-id" ] ~doc ~docv:"/path/to/library") in + Term.( const handle_error - $ (const compile_source $ odoc_file_directories $ dst $ source_parent_file - $ source_path $ input $ warnings_options)) + $ (const compile_impl $ odoc_file_directories $ output_dir $ parent_id + $ source_id $ input $ warnings_options)) let info ~docs = let doc = @@ -453,7 +436,7 @@ module Compile_src = struct containing the implementation information needed by odoc for the \ compilation unit." in - Term.info "compile-src" ~docs ~doc + Term.info "compile-impl" ~docs ~doc end module Indexing = struct @@ -1278,6 +1261,20 @@ module Odoc_error = struct ~doc:"Print errors that occurred while compiling or linking." end +module Classify = struct + let libdir = + let doc = "The directory containing the libraries" in + Arg.(required & pos 0 (some string) None & info ~doc ~docv:"DIR" []) + + let cmd = Term.(const handle_error $ (const Classify.classify $ libdir)) + + let info ~docs = + Term.info "classify" ~docs + ~doc: + "Classify the modules into libraries based on heuristics. Libraries \ + are specified by the --library option." +end + let section_pipeline = "COMMANDS: Compilation pipeline" let section_generators = "COMMANDS: Alternative generators" let section_support = "COMMANDS: Scripting" @@ -1305,7 +1302,7 @@ let () = Odoc_html.generate ~docs:section_pipeline; Support_files_command.(cmd, info ~docs:section_pipeline); Source_tree.(cmd, info ~docs:section_pipeline); - Compile_src.(cmd, info ~docs:section_pipeline); + Compile_impl.(cmd, info ~docs:section_pipeline); Indexing.(cmd, info ~docs:section_pipeline); Odoc_manpage.generate ~docs:section_generators; Odoc_latex.generate ~docs:section_generators; @@ -1325,6 +1322,7 @@ let () = Depends.Link.(cmd, info ~docs:section_legacy); Css.(cmd, info ~docs:section_deprecated); Depends.Odoc_html.(cmd, info ~docs:section_deprecated); + Classify.(cmd, info ~docs:section_pipeline); ] in let default = diff --git a/src/odoc/classify.cppo.ml b/src/odoc/classify.cppo.ml new file mode 100644 index 0000000000..946bedc0f5 --- /dev/null +++ b/src/odoc/classify.cppo.ml @@ -0,0 +1,415 @@ +(* Classify directories in ocamlfind *) + +(* Given a directory with cmis, cmas and so on, partition the modules between the libraries *) +(* open Bos *) + +open Cmo_format +open Result + +module StringSet = Set.Make (String) +let list_of_stringset x = + StringSet.fold (fun a b -> a :: b) x [] + +let debug = ref false + +let log fmt = + if !debug then Format.printf fmt else Format.ifprintf Format.std_formatter fmt + +module Archive = struct + type name = string + + type t = { + name : name; + modules : StringSet.t; + intf_deps : StringSet.t; + impl_deps : StringSet.t; + } + let empty name = + { + name; + modules = StringSet.empty; + intf_deps = StringSet.empty; + impl_deps = StringSet.empty; + } + + let normalise s = + { + s with + intf_deps = StringSet.diff s.intf_deps s.modules; + impl_deps = StringSet.diff s.impl_deps s.modules; + } + + let add_cu lib cu = + normalise + { + lib with + modules = + StringSet.add (Odoc_model.Compat.compunit_name cu.cu_name) lib.modules; + intf_deps = + List.fold_left + (fun deps (cu, _) -> StringSet.add cu deps) + lib.intf_deps cu.cu_imports; + impl_deps = + List.fold_left + (fun deps id -> StringSet.add id deps) + lib.impl_deps + (Odoc_model.Compat.required_compunit_names cu); + } + + let add_unit_info lib (unit_info : Cmx_format.unit_infos) = + normalise + { + lib with + modules = StringSet.add unit_info.ui_name lib.modules; + intf_deps = + List.fold_left + (fun deps (unit_info, _) -> StringSet.add unit_info deps) + lib.intf_deps unit_info.ui_imports_cmi; + impl_deps = + List.fold_left + (fun deps (name, _) -> StringSet.add name deps) + lib.impl_deps unit_info.ui_imports_cmx; + } + + let add_module_by_name lib name = + normalise { lib with modules = StringSet.add name lib.modules } + + let filter_by_cmis valid_cmis lib = + { + lib with + modules = StringSet.filter (fun m -> List.mem m valid_cmis) lib.modules; + } + + let has_modules a = StringSet.cardinal a.modules > 0 + + let pp ppf lib = + Fmt.pf ppf "Name: %s@.Modules: %a@.Intf deps: %a@.Impl_deps: %a@." lib.name + Fmt.(list ~sep:sp string) + (StringSet.elements lib.modules) + Fmt.(list ~sep:sp string) + (StringSet.elements lib.intf_deps) + Fmt.(list ~sep:sp string) + (StringSet.elements lib.impl_deps) +end + +module Cmi = struct + let get_deps filename = + let cmi, _cmt = Cmt_format.read filename in + match cmi with + | Some cmi -> List.map fst cmi.Cmi_format.cmi_crcs |> StringSet.of_list + | None -> StringSet.empty +end + +module Deps = struct + let closure deps = + let rec inner acc l = + match l with + | [] -> acc + | (x, deps) :: rest -> + let acc = + List.map + (fun (y, ydeps) -> + if StringSet.mem x ydeps then (y, StringSet.union ydeps deps) + else (y, ydeps)) + acc + in + inner acc rest + in + let rec loop acc = + let acc' = inner acc deps in + if acc = acc' then acc else loop acc' + in + loop deps + + (* Return a dag showing dependencies between archives due to module initialisation order *) + let impl_deps archives = + List.map + (fun l1 -> + let deps = + List.filter + (fun l2 -> + not + @@ StringSet.is_empty + (StringSet.inter l1.Archive.impl_deps l2.Archive.modules)) + archives + in + (l1.name, List.map (fun x -> x.Archive.name) deps |> StringSet.of_list)) + archives + |> closure +end + +let read_cma ic init = + let toc_pos = input_binary_int ic in + seek_in ic toc_pos; + let toc = (input_value ic : library) in + close_in ic; + Ok (List.fold_left Archive.add_cu init toc.lib_units) + +let read_cmxa ic init = + let li = (input_value ic : Cmx_format.library_infos) in + close_in ic; + Ok (List.fold_left Archive.add_unit_info init (List.map fst li.lib_units)) + +#if OCAML_VERSION >= (4, 12, 0) +open Misc + +let read_library ic init = + let open Magic_number in + match read_current_info ~expected_kind:None ic with + | Ok { kind = Cma; version = _ } -> read_cma ic init + | Ok { kind = Cmxa _; version = _ } -> read_cmxa ic init + | Ok { kind = _; version = _ } -> Error (`Msg "Not a valid library") + | Error _ -> Error (`Msg "Not a valid file") +#else +let read_library ic init = + let len_magic_number = String.length Config.cmo_magic_number in + let magic_number = really_input_string ic len_magic_number in + if magic_number = Config.cma_magic_number then read_cma ic init + else if magic_number = Config.cmxa_magic_number then read_cmxa ic init + else Error (`Msg "Not a valid library") +#endif + +#if OCAML_VERSION > (4, 12, 0) +let read_cmi ic = + let open Magic_number in + match read_current_info ~expected_kind:None ic with + | Ok { kind = Cmi; version = _ } -> + let cmi = (input_value ic : Cmi_format.cmi_infos) in + close_in ic; + Ok cmi + | Ok { kind = _; version = _ } -> Error (`Msg "Not a valid cmi") + | Error _ -> Error (`Msg "Not a valid file") +#else +let read_cmi ic = + let len_magic_number = String.length Config.cmo_magic_number in + let magic_number = really_input_string ic len_magic_number in + if magic_number = Config.cmi_magic_number + then begin + let cmi = (input_value ic : Cmi_format.cmi_infos) in + close_in ic; + Ok cmi + end else Error (`Msg "Not a valid file") + +#endif + +let classify dir files libraries = + let libraries = StringSet.elements libraries in + + let archives = + List.map + (fun lname -> + let path ext = Fpath.(v dir / lname |> set_ext ext |> to_string) in + let paths = [ path ".cma"; path ".cmxa" ] in + List.fold_left + (fun cur path -> + if not (Sys.file_exists path) then cur + else + let ic = open_in_bin path in + match read_library ic cur with + | Ok lib -> lib + | Error (`Msg m) -> + Format.eprintf "Error reading library: %s\n%!" m; + cur) + (Archive.empty lname) paths) + libraries + in + + let cmis = List.filter (fun f -> Fpath.(has_ext ".cmi" (v f))) files in + let cmi_names = + List.map + (fun f -> Fpath.(rem_ext (v f) |> basename |> Astring.String.Ascii.capitalize)) + cmis + in + + let _impls, intfs = + let check f ext = + Sys.file_exists Fpath.(v dir / f |> set_ext ext |> to_string) + in + List.partition (fun f -> check f ".cmo" || check f "cmx") cmis + in + + let intfs_deps = + List.map + (fun f -> + let modname = + Filename.chop_suffix f ".cmi" |> Astring.String.Ascii.capitalize + in + (modname, Cmi.get_deps Fpath.(v dir / f |> to_string))) + intfs + in + + let modules = List.map fst intfs_deps in + + let orphaned_modules = + List.filter + (fun module_name -> + not + @@ List.exists + (fun lib -> StringSet.mem module_name lib.Archive.modules) + archives) + modules + in + + let libdeps = Deps.impl_deps archives in + + let rec topo_sort l = + match l with + | [] -> [] + | _ -> + let no_deps, rest = + List.partition (function _, x -> StringSet.is_empty x) l + in + let no_dep_names = List.map fst no_deps |> StringSet.of_list in + let rest = + List.map (fun (x, deps) -> (x, StringSet.diff deps no_dep_names)) rest + in + (list_of_stringset no_dep_names) @ topo_sort rest + in + + let all_sorted = topo_sort libdeps in + let find_lib m = + log "Checking module: %s\n%!" m; + + (* If our module depends on a library, it shouldn't be in any dependency of that library *) + log "Modules dependencies: %a\n%!" + Fmt.(list ~sep:sp string) + (List.assoc m intfs_deps |> list_of_stringset); + let denylist = + List.fold_left + (fun acc archive -> + let lib_dependent_modules = + StringSet.inter (List.assoc m intfs_deps) archive.Archive.modules + in + if StringSet.cardinal lib_dependent_modules > 0 then ( + log "Module %s has dependencies [%a] in archive %s\n%!" m + Fmt.(list ~sep:sp string) + (list_of_stringset lib_dependent_modules) + archive.Archive.name; + log "Therefore denying: %a\n%!" + Fmt.(list ~sep:sp string) + (List.assoc archive.name libdeps + |> list_of_stringset); + StringSet.union acc (List.assoc archive.name libdeps)) + else acc) + StringSet.empty archives + in + + log "Denylist: %a\n%!" + Fmt.(list ~sep:sp string) + (StringSet.elements denylist); + + (* If library x depends upon our module, our module can't be in any library that depends upon x *) + let denylist2 = + List.fold_left + (fun acc archive -> + if StringSet.mem m archive.Archive.intf_deps then ( + log "Archive %s is dependent on interface of module %s\n%!" + archive.Archive.name m; + List.fold_left + (fun acc (x, deps) -> + if StringSet.mem archive.name deps then ( + log "archive %s depends on archive %s so removing it!\n%!" x + archive.name; + StringSet.add x acc) + else acc) + acc libdeps) + else acc) + StringSet.empty archives + in + log "Denylist2: %a\n%!" + Fmt.(list ~sep:sp string) + (StringSet.elements denylist2); + + (* We prefer to put the module into a library that depends upon our module *) + let goodlist = + List.fold_left + (fun acc archive -> + if StringSet.mem m archive.Archive.intf_deps then + StringSet.add archive.name acc + else acc) + StringSet.empty archives + in + log "Goodlist: %a\n%!" + Fmt.(list ~sep:sp string) + (StringSet.elements goodlist); + + let goodlist2 = + List.fold_left + (fun acc archive -> + if + StringSet.inter archive.Archive.modules (List.assoc m intfs_deps) + |> StringSet.cardinal > 0 + then StringSet.add archive.name acc + else acc) + StringSet.empty archives + in + + let goodlist = StringSet.union goodlist goodlist2 in + + log "Goodlist: %a\n%!" + Fmt.(list ~sep:sp string) + (StringSet.elements goodlist); + + let possibilities = + StringSet.of_list (List.map (fun x -> x.Archive.name) archives) + in + let possibilities = StringSet.diff possibilities denylist in + let possibilities = StringSet.diff possibilities denylist2 in + + let possibilities = + if StringSet.is_empty possibilities then goodlist + (* This can happen, e.g. if Instruct was an interface only module *) + else StringSet.inter goodlist possibilities + in + + log "Possibilities: %a\n%!" + Fmt.(list ~sep:sp string) + (StringSet.elements possibilities); + + let result = + try List.find (fun lib -> StringSet.mem lib possibilities) all_sorted + with Not_found -> + log "Defaulting to %s\n%!" (List.hd all_sorted); + List.hd all_sorted + in + + List.find (fun a -> a.Archive.name = result) archives + in + + let module_libs = + List.map + (fun modname -> (modname, (find_lib modname).Archive.name)) + orphaned_modules + in + + List.iter + (fun a -> + let archive_all = + List.fold_left + (fun a (m, lib) -> + if lib = a.Archive.name then Archive.add_module_by_name a m else a) + a module_libs + in + let archive = Archive.filter_by_cmis cmi_names archive_all in + if Archive.has_modules archive then + Printf.printf "%s %s\n" a.Archive.name + (archive.Archive.modules |> StringSet.elements |> String.concat " ")) + archives; + + () + +let classify dir = + let files = Sys.readdir dir |> Array.to_list in + + let libraries = + List.fold_left + (fun acc f -> + let p = Fpath.v f in + if Fpath.has_ext ".cma" p || Fpath.has_ext ".cmxa" p then + StringSet.add Fpath.(rem_ext p |> to_string) acc + else acc) + StringSet.empty files + in + + if StringSet.cardinal libraries = 0 then Ok () + else Ok (classify dir files libraries) diff --git a/src/odoc/compile.ml b/src/odoc/compile.ml index 9afb732b30..68a1b64317 100644 --- a/src/odoc/compile.ml +++ b/src/odoc/compile.ml @@ -21,14 +21,22 @@ open Or_error type parent_spec = | Explicit of Paths.Identifier.ContainerPage.t * Lang.Page.child list - | Package of Paths.Identifier.ContainerPage.t + | ParentId of Paths.Identifier.ContainerPage.t | Noparent type parent_cli_spec = | CliParent of string | CliPackage of string + | CliParentId of string | CliNoparent +let rec path_of_id output_dir id = + match (id : Paths.Identifier.ContainerPage.t).iv with + | `Page (None, p) -> Fpath.(v output_dir / PageName.to_string p) + | `Page (Some parent, p) -> + let d = path_of_id output_dir parent in + Fpath.(d / PageName.to_string p) + let check_is_empty msg = function [] -> Ok () | _ :: _ -> Error (`Msg msg) (** Used to disambiguate child references. *) @@ -77,13 +85,23 @@ let resolve_parent_page resolver f = find_parent r >>= fun page -> extract_parent page.name >>= fun parent -> Ok (parent, page.children) +let mk_id str = + let l = String.cuts ~sep:"/" str in + List.fold_left + (fun acc id -> Some (Paths.Identifier.Mk.page (acc, PageName.make_std id))) + None l + |> function + | Some x -> x + | None -> failwith "Failed to create ID" + let parent resolver parent_cli_spec = match parent_cli_spec with | CliParent f -> resolve_parent_page resolver f >>= fun (parent, children) -> Ok (Explicit (parent, children)) | CliPackage package -> - Ok (Package (Paths.Identifier.Mk.page (None, PageName.make_std package))) + Ok (ParentId (Paths.Identifier.Mk.page (None, PageName.make_std package))) + | CliParentId id -> Ok (ParentId (mk_id id)) | CliNoparent -> Ok Noparent let resolve_imports resolver imports = @@ -135,9 +153,6 @@ let resolve_and_substitute ~resolver ~make_root ~hidden let root_of_compilation_unit ~parent_spec ~hidden ~output ~module_name ~digest = let open Root in - let filename = - Filename.chop_extension Fs.File.(to_string @@ basename output) - in let result parent = let file = Odoc_file.create_unit ~force_hidden:hidden module_name in Ok @@ -149,6 +164,9 @@ let root_of_compilation_unit ~parent_spec ~hidden ~output ~module_name ~digest = in let check_child = function | Lang.Page.Module_child n -> + let filename = + Filename.chop_extension Fs.File.(to_string @@ basename output) + in String.Ascii.(uncapitalize n = uncapitalize filename) | Asset_child _ | Source_tree_child _ | Page_child _ -> false in @@ -157,7 +175,18 @@ let root_of_compilation_unit ~parent_spec ~hidden ~output ~module_name ~digest = | Explicit (parent, children) -> if List.exists check_child children then result (Some parent) else Error (`Msg "Specified parent is not a parent of this file") - | Package parent -> result (Some parent) + | ParentId parent -> result (Some parent) + +(* + let d = path_of_id parent in + Fs.Directory.mkdir_p (Fs.Directory.of_string (Fpath.to_string d)); + let file = Odoc_file.create_unit ~force_hidden:hidden module_name in + Ok { + id = Paths.Identifier.Mk.root (Some parent, ModuleName.make_std module_name); + file; + digest; + } + in *) let name_of_output ~prefix output = let page_dash_root = @@ -175,7 +204,7 @@ let page_name_of_output ~is_parent_explicit output = | _ -> ()); root_name -let mld ~parent_spec ~output ~children ~warnings_options input = +let mld ~parent_spec ~output ~output_dir ~children ~warnings_options input = List.fold_left (fun acc child_str -> match (acc, parse_parent_child_reference child_str) with @@ -203,7 +232,7 @@ let mld ~parent_spec ~output ~children ~warnings_options input = (* No children, this is a leaf page. *) match parent_spec with | Explicit (p, _) -> Ok (Paths.Identifier.Mk.leaf_page (Some p, page_name)) - | Package parent -> + | ParentId parent -> Ok (Paths.Identifier.Mk.leaf_page (Some parent, page_name)) | Noparent -> Ok (Paths.Identifier.Mk.leaf_page (None, page_name)) else @@ -215,7 +244,7 @@ let mld ~parent_spec ~output ~children ~warnings_options input = (match parent_spec with | Explicit (p, cs) -> check cs @@ Paths.Identifier.Mk.page (Some p, page_name) - | Package parent -> + | ParentId parent -> Ok (Paths.Identifier.Mk.page (Some parent, page_name)) (* This is a bit odd *) | Noparent -> Ok (Paths.Identifier.Mk.page (None, page_name))) @@ -225,6 +254,20 @@ let mld ~parent_spec ~output ~children ~warnings_options input = let file = Root.Odoc_file.create_page root_name in { Root.id = (name :> Paths.Identifier.OdocId.t); file; digest } in + let output = + match (parent_spec, output_dir) with + | ParentId parent, Some output_dir -> + let name = Fs.File.set_ext ".odoc" input in + let name = Fs.File.basename name in + let name = "page-" ^ Fs.File.to_string name in + Fs.File.create + ~directory: + (path_of_id output_dir parent + |> Fpath.to_string |> Fs.Directory.of_string) + ~name + | _ -> output + in + let resolve content = let page = Lang.Page.{ name; root; children; content; digest; linked = false } @@ -247,22 +290,35 @@ let handle_file_ext ext = | _ -> Error (`Msg "Unknown extension, expected one of: cmti, cmt, cmi or mld.") -let compile ~resolver ~parent_cli_spec ~hidden ~children ~output +let compile ~resolver ~parent_cli_spec ~hidden ~children ~output ~output_dir ~warnings_options input = parent resolver parent_cli_spec >>= fun parent_spec -> let ext = Fs.File.get_ext input in if ext = ".mld" then - mld ~parent_spec ~output ~warnings_options ~children input + mld ~parent_spec ~output ~output_dir ~warnings_options ~children input else check_is_empty "Not expecting children (--child) when compiling modules." children >>= fun () -> handle_file_ext ext >>= fun input_type -> - let parent = - match parent_spec with - | Noparent -> None - | Explicit (parent, _) -> Some parent - | Package parent -> Some parent + let parent, output = + match (parent_spec, output_dir) with + | Noparent, _ -> (None, output) + | Explicit (parent, _), _ -> (Some parent, output) + | ParentId parent, None -> (Some parent, output) + | ParentId parent, Some output_dir -> + let filename = + let name = Fs.File.basename input in + Fs.File.create + ~directory: + (path_of_id output_dir parent + |> Fpath.to_string |> Fs.Directory.of_string) + ~name: + (Fs.File.set_ext ".odoc" name + |> Fpath.to_string |> String.Ascii.uncapitalize) + in + + (Some parent, Fs.File.(set_ext ".odoc" filename)) in let make_root = root_of_compilation_unit ~parent_spec ~hidden ~output in let result = diff --git a/src/odoc/compile.mli b/src/odoc/compile.mli index a8b2c5f867..3a3713b362 100644 --- a/src/odoc/compile.mli +++ b/src/odoc/compile.mli @@ -21,6 +21,7 @@ open Or_error type parent_cli_spec = | CliParent of string | CliPackage of string + | CliParentId of string | CliNoparent val name_of_output : prefix:string -> Fs.File.t -> string @@ -39,12 +40,15 @@ val resolve_parent_page : (** Parse and resolve a parent reference. Returns the identifier of the parent and its children as a list of reference. *) +val mk_id : string -> Identifier.ContainerPage.t + val compile : resolver:Resolver.t -> parent_cli_spec:parent_cli_spec -> hidden:bool -> children:string list -> output:Fs.File.t -> + output_dir:string option -> warnings_options:Odoc_model.Error.warnings_options -> Fs.File.t -> (unit, [> msg ]) result diff --git a/src/odoc/dune b/src/odoc/dune index d7c04fa956..3b967f805f 100644 --- a/src/odoc/dune +++ b/src/odoc/dune @@ -19,5 +19,14 @@ (instrumentation (backend bisect_ppx))) +(rule + (targets classify.ml) + (deps + (:x classify.cppo.ml)) + (action + (chdir + %{workspace_root} + (run %{bin:cppo} -V OCAML:%{ocaml_version} %{x} -o %{targets})))) + (documentation (package odoc)) diff --git a/src/odoc/odoc_file.ml b/src/odoc/odoc_file.ml index cb308be69f..f7f00fd79b 100644 --- a/src/odoc/odoc_file.ml +++ b/src/odoc/odoc_file.ml @@ -62,8 +62,8 @@ let save_impl file ~warnings impl = let dir = Fs.File.dirname file in let base = Fs.File.(to_string @@ basename file) in let file = - if Astring.String.is_prefix ~affix:"src-" base then file - else Fs.File.create ~directory:dir ~name:("src-" ^ base) + if Astring.String.is_prefix ~affix:"impl-" base then file + else Fs.File.create ~directory:dir ~name:("impl-" ^ base) in save_unit file impl.Lang.Implementation.root { content = Impl_content impl; warnings } diff --git a/src/odoc/resolver.ml b/src/odoc/resolver.ml index 80a7265424..6d30f67a8b 100644 --- a/src/odoc/resolver.ml +++ b/src/odoc/resolver.ml @@ -206,7 +206,7 @@ let lookup_page ap target_name = (** Lookup an implementation. *) let lookup_impl ap target_name = - let target_name = "src-" ^ Astring.String.Ascii.uncapitalize target_name in + let target_name = "impl-" ^ Astring.String.Ascii.uncapitalize target_name in let is_impl u = match u with | Odoc_file.Impl_content p -> Some p diff --git a/src/odoc/source.ml b/src/odoc/source.ml index 92dee0efc2..725f4c4d9e 100644 --- a/src/odoc/source.ml +++ b/src/odoc/source.ml @@ -19,25 +19,12 @@ let root_of_implementation ~source_id ~module_name ~digest = let id :> Paths.Identifier.OdocId.t = source_id in Ok { id; file; digest } -let compile ~resolver ~output ~warnings_options ~source_path ~source_parent_file - input = - ( Odoc_file.load source_parent_file >>= fun parent -> - let err_not_parent () = - Error (`Msg "Specified source-parent is not a parent of the source.") - in - match parent.Odoc_file.content with - | Odoc_file.Source_tree_content page -> ( - match page.Lang.SourceTree.name with - | { Paths.Identifier.iv = `Page _; _ } as parent_id -> - let id = Paths.Identifier.Mk.source_page (parent_id, source_path) in - if List.exists (Paths.Identifier.equal id) page.source_children then - Ok id - else err_not_parent () - | { iv = `LeafPage _; _ } -> err_not_parent ()) - | Unit_content _ | Page_content _ | Impl_content _ -> - Error (`Msg "Specified source-parent should be a page but is a module.") - ) - >>= fun source_id -> +let compile ~resolver ~output ~warnings_options ~source_id input = + let parent_id, name = Fpath.(split_base (v source_id)) in + let parent = Compile.mk_id Fpath.(to_string (rem_empty_seg parent_id)) in + let source_id = + Paths.Identifier.Mk.source_page (parent, [ Fpath.to_string name ]) + in let make_root = root_of_implementation ~source_id in let result = Error.catch_errors_and_warnings (fun () -> diff --git a/test/integration/json_expansion_with_sources.t/run.t b/test/integration/json_expansion_with_sources.t/run.t index b08c1a7d52..03ade30627 100644 --- a/test/integration/json_expansion_with_sources.t/run.t +++ b/test/integration/json_expansion_with_sources.t/run.t @@ -1,19 +1,13 @@ Test the JSON output in the presence of expanded modules. - $ odoc compile --child module-a --child srctree-source root.mld - - $ printf "a.ml\nmain.ml\n" > source_tree.map - $ odoc source-tree -I . --parent page-root -o srctree-source.odoc source_tree.map - - $ ocamlc -c -bin-annot -o main__A.cmo a.ml -I . $ ocamlc -c -bin-annot main.ml -I . - $ odoc compile-src --source-path a.ml --parent srctree-source.odoc -I . main__A.cmt + $ odoc compile-impl --source-id a.ml -I . main__A.cmt --output-dir . $ odoc compile -I . main__A.cmt - $ odoc compile-src --source-path main.ml --parent srctree-source.odoc -I . main.cmt + $ odoc compile-impl --source-id main.ml -I . main.cmt --output-dir . $ odoc compile -I . main.cmt - $ odoc link -I . src-main__A.odoc - $ odoc link -I . src-main.odoc + $ odoc link -I . impl-main__A.odoc + $ odoc link -I . impl-main.odoc $ odoc link -I . main__A.odoc $ odoc link -I . main.odoc @@ -29,28 +23,28 @@ Test the JSON output in the presence of expanded modules. html/Main/index.html.json html/Main/A/index.html.json html/Main/A/B/index.html.json - $ odoc html-targets --source a.ml -o html src-main__A.odocl - html/root/source/a.ml.html - $ odoc html-targets --source main.ml -o html src-main.odocl - html/root/source/main.ml.html - $ odoc html-targets --source a.ml --as-json -o html src-main__A.odocl - html/root/source/a.ml.html.json - $ odoc html-targets --source main.ml --as-json -o html src-main.odocl - html/root/source/main.ml.html.json - - $ odoc html-generate --source a.ml --as-json -o html src-main__A.odocl + $ odoc html-targets --source a.ml -o html impl-main__A.odocl + html/a.ml.html + $ odoc html-targets --source main.ml -o html impl-main.odocl + html/main.ml.html + $ odoc html-targets --source a.ml --as-json -o html impl-main__A.odocl + html/a.ml.html.json + $ odoc html-targets --source main.ml --as-json -o html impl-main.odocl + html/main.ml.html.json + + $ odoc html-generate --source a.ml --as-json -o html impl-main__A.odocl $ odoc html-generate --as-json -o html main__A.odocl - $ odoc html-generate --source main.ml --as-json -o html src-main.odocl + $ odoc html-generate --source main.ml --as-json -o html impl-main.odocl $ odoc html-generate --as-json -o html main.odocl $ cat html/Main/index.html.json - {"type":"documentation","uses_katex":false,"breadcrumbs":[{"name":"Main","href":"#","kind":"module"}],"toc":[],"source_anchor":"../root/source/main.ml.html","preamble":"","content":"
Sourcemodule A : sig ... end
"} + {"type":"documentation","uses_katex":false,"breadcrumbs":[{"name":"Main","href":"#","kind":"module"}],"toc":[],"source_anchor":".././main.ml.html","preamble":"","content":"
Sourcemodule A : sig ... end
"} $ cat html/Main/A/index.html.json - {"type":"documentation","uses_katex":false,"breadcrumbs":[{"name":"Main","href":"../index.html","kind":"module"},{"name":"A","href":"#","kind":"module"}],"toc":[],"source_anchor":"../../root/source/a.ml.html","preamble":"","content":"
Sourcemodule B : sig ... end
"} + {"type":"documentation","uses_katex":false,"breadcrumbs":[{"name":"Main","href":"../index.html","kind":"module"},{"name":"A","href":"#","kind":"module"}],"toc":[],"source_anchor":"../.././a.ml.html","preamble":"","content":"
Sourcemodule B : sig ... end
"} $ cat html/Main/A/B/index.html.json - {"type":"documentation","uses_katex":false,"breadcrumbs":[{"name":"Main","href":"../../index.html","kind":"module"},{"name":"A","href":"../index.html","kind":"module"},{"name":"B","href":"#","kind":"module"}],"toc":[],"source_anchor":"../../../root/source/a.ml.html#module-B","preamble":"","content":""} + {"type":"documentation","uses_katex":false,"breadcrumbs":[{"name":"Main","href":"../../index.html","kind":"module"},{"name":"A","href":"../index.html","kind":"module"},{"name":"B","href":"#","kind":"module"}],"toc":[],"source_anchor":"../../.././a.ml.html#module-B","preamble":"","content":""} - $ cat html/root/source/a.ml.html.json - {"type":"source","breadcrumbs":[{"name":"root","href":"../index.html","kind":"page"},{"name":"source","href":"index.html","kind":"page"},{"name":"a.ml","href":"#","kind":"source"}],"content":"
1\u000Amodule B = struct end\u000A
"} + $ cat html/a.ml.html.json + {"type":"source","breadcrumbs":[{"name":".","href":"index.html","kind":"page"},{"name":"a.ml","href":"#","kind":"source"}],"content":"
1\u000Amodule B = struct end\u000A
"} diff --git a/test/occurrences/double_wrapped.t/run.t b/test/occurrences/double_wrapped.t/run.t index 3c2cb122b9..6ca6c867c5 100644 --- a/test/occurrences/double_wrapped.t/run.t +++ b/test/occurrences/double_wrapped.t/run.t @@ -10,17 +10,13 @@ The module B depends on both B and C, the module C only depends on A. $ ocamlc -c -open Main__ -o main__B.cmo b.ml -bin-annot -I . $ ocamlc -c -open Main__ main.ml -bin-annot -I . -Collecting occurrences is done on implementation files. We thus need a source tree as a parent. +Collecting occurrences is done on implementation files. - $ odoc compile -c srctree-source root.mld - $ printf "a.ml\nb.ml\nc.ml\nmain.ml\nmain__.ml\n" > source_tree.map - $ odoc source-tree -I . --parent page-root -o srctree-source.odoc source_tree.map - - $ odoc compile-src --source-path a.ml --parent srctree-source.odoc -I . main__A.cmt - $ odoc compile-src --source-path c.ml --parent srctree-source.odoc -I . main__C.cmt - $ odoc compile-src --source-path b.ml --parent srctree-source.odoc -I . main__B.cmt - $ odoc compile-src --source-path main__.ml --parent srctree-source.odoc -I . main__.cmt - $ odoc compile-src --source-path main.ml --parent srctree-source.odoc -I . main.cmt + $ odoc compile-impl --source-id a.ml -I . main__A.cmt --output-dir . + $ odoc compile-impl --source-id c.ml -I . main__C.cmt --output-dir . + $ odoc compile-impl --source-id b.ml -I . main__B.cmt --output-dir . + $ odoc compile-impl --source-id main__.ml -I . main__.cmt --output-dir . + $ odoc compile-impl --source-id main.ml -I . main.cmt --output-dir . We need the interface version to resolve the occurrences @@ -32,11 +28,11 @@ We need the interface version to resolve the occurrences Let's link the implementations - $ odoc link -I . src-main.odoc - $ odoc link -I . src-main__A.odoc - $ odoc link -I . src-main__B.odoc - $ odoc link -I . src-main__C.odoc - $ odoc link -I . src-main__.odoc + $ odoc link -I . impl-main.odoc + $ odoc link -I . impl-main__A.odoc + $ odoc link -I . impl-main__B.odoc + $ odoc link -I . impl-main__C.odoc + $ odoc link -I . impl-main__.odoc The count occurrences command outputs a marshalled hashtable, whose keys are odoc identifiers, and whose values are integers corresponding to the number of @@ -49,11 +45,11 @@ and a hashtable for each compilation unit. $ mkdir main__B $ mkdir main__C - $ mv src-main.odocl main - $ mv src-main__.odocl main__ - $ mv src-main__A.odocl main__A - $ mv src-main__B.odocl main__B - $ mv src-main__C.odocl main__C + $ mv impl-main.odocl main + $ mv impl-main__.odocl main__ + $ mv impl-main__A.odocl main__A + $ mv impl-main__B.odocl main__B + $ mv impl-main__C.odocl main__C $ odoc count-occurrences -I main -o occurrences-main.odoc $ odoc count-occurrences -I main__ -o occurrences-main__.odoc $ odoc count-occurrences -I main__A -o occurrences-main__A.odoc @@ -70,9 +66,6 @@ Uses of B.Z are not counted since they go to a hidden module. Uses of values Y.x and Z.y (in b.ml) are not counted since they come from a "local" module. $ occurrences_print occurrences-main.odoc | sort - Main was used directly 0 times and indirectly 2 times - Main.A was used directly 1 times and indirectly 0 times - Main.B was used directly 1 times and indirectly 0 times $ occurrences_print occurrences-main__.odoc | sort @@ -81,18 +74,9 @@ A only uses "persistent" values: one it defines itself. "Aliased" values are not counted since they become persistent $ occurrences_print occurrences-main__B.odoc | sort - Main was used directly 0 times and indirectly 7 times - Main.A was used directly 2 times and indirectly 5 times - Main.A.(||>) was used directly 1 times and indirectly 0 times - Main.A.M was used directly 2 times and indirectly 0 times - Main.A.t was used directly 1 times and indirectly 0 times - Main.A.x was used directly 1 times and indirectly 0 times "Aliased" values are not counted since they become persistent $ occurrences_print occurrences-main__C.odoc | sort - Main was used directly 0 times and indirectly 2 times - Main.A was used directly 1 times and indirectly 1 times - Main.A.x was used directly 1 times and indirectly 0 times Now we can merge all tables @@ -105,13 +89,6 @@ Now we can merge all tables $ occurrences_print occurrences-aggregated.odoc | sort > all_merged $ cat all_merged - Main was used directly 0 times and indirectly 11 times - Main.A was used directly 4 times and indirectly 6 times - Main.A.(||>) was used directly 1 times and indirectly 0 times - Main.A.M was used directly 2 times and indirectly 0 times - Main.A.t was used directly 1 times and indirectly 0 times - Main.A.x was used directly 2 times and indirectly 0 times - Main.B was used directly 1 times and indirectly 0 times Compare with the one created directly with all occurrences: @@ -123,28 +100,6 @@ We can also include hidden ids: $ odoc count-occurrences -I main__B -o occurrences-b.odoc --include-hidden $ occurrences_print occurrences-b.odoc | sort - Main was used directly 0 times and indirectly 7 times - Main.A was used directly 2 times and indirectly 5 times - Main.A.(||>) was used directly 1 times and indirectly 0 times - Main.A.M was used directly 2 times and indirectly 0 times - Main.A.t was used directly 1 times and indirectly 0 times - Main.A.x was used directly 1 times and indirectly 0 times - Main__ was used directly 0 times and indirectly 2 times - Main__.C was used directly 1 times and indirectly 1 times - Main__.C.y was used directly 1 times and indirectly 0 times $ odoc count-occurrences -I . -o occurrences-all.odoc --include-hidden $ occurrences_print occurrences-all.odoc | sort - Main was used directly 0 times and indirectly 11 times - Main.A was used directly 4 times and indirectly 6 times - Main.A.(||>) was used directly 1 times and indirectly 0 times - Main.A.M was used directly 2 times and indirectly 0 times - Main.A.t was used directly 1 times and indirectly 0 times - Main.A.x was used directly 2 times and indirectly 0 times - Main.B was used directly 1 times and indirectly 0 times - Main__ was used directly 0 times and indirectly 2 times - Main__.C was used directly 1 times and indirectly 1 times - Main__.C.y was used directly 1 times and indirectly 0 times - Main__A was used directly 1 times and indirectly 0 times - Main__B was used directly 1 times and indirectly 0 times - Main__C was used directly 1 times and indirectly 0 times diff --git a/test/sources/double_wrapped.t/run.t b/test/sources/double_wrapped.t/run.t index f7d120a1bc..ef49b7357e 100644 --- a/test/sources/double_wrapped.t/run.t +++ b/test/sources/double_wrapped.t/run.t @@ -1,32 +1,27 @@ This is what happens when a dune user write a toplevel module. Similar to the lookup_def_wrapped test. - $ odoc compile -c module-a -c srctree-source root.mld - - $ printf "a.ml\nmain.ml\nmain__.ml\n" > source_tree.map - $ odoc source-tree -I . --parent page-root -o srctree-source.odoc source_tree.map - $ ocamlc -c -o main__A.cmo a.ml -bin-annot -I . $ ocamlc -c -o main__.cmo main__.ml -bin-annot -I . $ ocamlc -c -open Main__ main.ml -bin-annot -I . - $ odoc compile-src --source-path a.ml --parent srctree-source.odoc -I . main__A.cmt + $ odoc compile-impl --source-id a.ml -I . main__A.cmt --output-dir . $ odoc compile -I . main__A.cmt - $ odoc compile-src --source-path main__.ml --parent srctree-source.odoc -I . main__.cmt + $ odoc compile-impl --source-id main__.ml -I . main__.cmt --output-dir . $ odoc compile -I . main__.cmt - $ odoc compile-src --source-path main.ml --parent srctree-source.odoc -I . main.cmt + $ odoc compile-impl --source-id main.ml -I . main.cmt --output-dir . $ odoc compile -I . main.cmt $ odoc link -I . main.odoc - $ odoc link -I . src-main__A.odoc - $ odoc link -I . src-main.odoc - $ odoc link -I . src-main__.odoc + $ odoc link -I . impl-main__A.odoc + $ odoc link -I . impl-main.odoc + $ odoc link -I . impl-main__.odoc $ odoc link -I . main__A.odoc $ odoc link -I . main__.odoc $ odoc html-generate --indent -o html main.odocl - $ odoc html-generate --source main.ml --indent -o html src-main.odocl - $ odoc html-generate --source a.ml --indent -o html src-main__A.odocl + $ odoc html-generate --source main.ml --indent -o html impl-main.odocl + $ odoc html-generate --source a.ml --indent -o html impl-main__A.odocl Look if all the source files are generated: @@ -36,10 +31,8 @@ Look if all the source files are generated: html/Main/A html/Main/A/index.html html/Main/index.html - html/root - html/root/source - html/root/source/a.ml.html - html/root/source/main.ml.html + html/a.ml.html + html/main.ml.html $ cat html/Main/A/index.html @@ -57,15 +50,15 @@ Look if all the source files are generated:

Module Main.A - Source + Source

- Source - val x : int + Source + val x : int
diff --git a/test/sources/functor.t/run.t b/test/sources/functor.t/run.t index 52ff88ef54..f2231fd09d 100644 --- a/test/sources/functor.t/run.t +++ b/test/sources/functor.t/run.t @@ -1,30 +1,25 @@ Verify the behavior on functors. - $ odoc compile -c module-a -c srctree-source root.mld - - $ printf "s.ml\na.ml\nb.ml\n" > source_tree.map - $ odoc source-tree -I . --parent page-root -o srctree-source.odoc source_tree.map - $ ocamlc -c -o s.cmo s.ml -bin-annot -I . $ ocamlc -c -o a.cmo a.ml -bin-annot -I . $ ocamlc -c -o b.cmo b.ml -bin-annot -I . - $ odoc compile-src --source-path s.ml --parent srctree-source.odoc -I . s.cmt + $ odoc compile-impl --source-id s.ml -I . s.cmt --output-dir . $ odoc compile -I . s.cmt - $ odoc compile-src --source-path a.ml --parent srctree-source.odoc -I . a.cmt + $ odoc compile-impl --source-id a.ml -I . a.cmt --output-dir . $ odoc compile -I . a.cmt - $ odoc compile-src --source-path b.ml --parent srctree-source.odoc -I . b.cmt + $ odoc compile-impl --source-id b.ml -I . b.cmt --output-dir . $ odoc compile -I . b.cmt $ odoc link -I . s.odoc $ odoc link -I . a.odoc $ odoc link -I . b.odoc - $ odoc link -I . src-s.odoc - $ odoc link -I . src-a.odoc - $ odoc link -I . src-b.odoc - $ odoc html-generate --source s.ml --indent -o html src-s.odocl + $ odoc link -I . impl-s.odoc + $ odoc link -I . impl-a.odoc + $ odoc link -I . impl-b.odoc + $ odoc html-generate --source s.ml --indent -o html impl-s.odocl $ odoc html-generate --indent -o html s.odocl - $ odoc html-generate --source a.ml --indent -o html src-a.odocl + $ odoc html-generate --source a.ml --indent -o html impl-a.odocl $ odoc html-generate --indent -o html a.odocl - $ odoc html-generate --source b.ml --indent -o html src-b.odocl + $ odoc html-generate --source b.ml --indent -o html impl-b.odocl $ odoc html-generate --indent -o html b.odocl $ find html | sort @@ -45,50 +40,49 @@ Verify the behavior on functors. html/S/index.html html/S/module-type-S html/S/module-type-S/index.html - html/root - html/root/source - html/root/source/a.ml.html - html/root/source/b.ml.html - html/root/source/s.ml.html + html/a.ml.html + html/b.ml.html + html/s.ml.html In this test, the functor expansion contains the right link. $ cat html/A/F/index.html | grep source_link -C 1

Module A.F - Source - + Source +

-- - Source + + Source -- - - Source + Source + $ cat html/root/source/a.ml.html | grep L3 - 3 + cat: html/root/source/a.ml.html: No such file or directory + [1] However, on functor results, there is a link to source in the file: $ cat html/B/R/index.html | grep source_link -C 2

Module B.R - Source - + Source

+
-- +
- Source + Source type t --
- - Source + Source + Source links in functor parameters might not make sense. Currently we generate none: diff --git a/test/sources/include_in_expansion.t/run.t b/test/sources/include_in_expansion.t/run.t index 980f768cb0..db91e1eb73 100644 --- a/test/sources/include_in_expansion.t/run.t +++ b/test/sources/include_in_expansion.t/run.t @@ -2,28 +2,25 @@ Checking that source parents are kept, using include. $ odoc compile -c module-a -c srctree-source root.mld - $ printf "a.ml\nb.ml\nmain.ml\n" > source_tree.map - $ odoc source-tree -I . --parent page-root -o srctree-source.odoc source_tree.map - $ ocamlc -c -o b.cmo b.ml -bin-annot -I . $ ocamlc -c -o main__A.cmo a.ml -bin-annot -I . $ ocamlc -c main.ml -bin-annot -I . - $ odoc compile-src --source-path b.ml --parent srctree-source.odoc -I . b.cmt + $ odoc compile-impl --source-id b.m -I . b.cmt --output-dir . $ odoc compile -I . b.cmt - $ odoc compile-src --source-path a.ml --parent srctree-source.odoc -I . main__A.cmt + $ odoc compile-impl --source-id a.ml -I . main__A.cmt --output-dir . $ odoc compile -I . main__A.cmt - $ odoc compile-src --source-path main.ml --parent srctree-source.odoc -I . main.cmt + $ odoc compile-impl --source-id main.ml -I . main.cmt --output-dir . $ odoc compile -I . main.cmt $ odoc link -I . main.odoc $ odoc link -I . main__A.odoc - $ odoc link -I . src-main.odoc - $ odoc link -I . src-main__A.odoc + $ odoc link -I . impl-main.odoc + $ odoc link -I . impl-main__A.odoc - $ odoc html-generate --source main.ml --indent -o html src-main.odocl + $ odoc html-generate --source main.ml --indent -o html impl-main.odocl $ odoc html-generate --indent -o html main.odocl - $ odoc html-generate --source a.ml --hidden --indent -o html src-main__A.odocl + $ odoc html-generate --source a.ml --hidden --indent -o html impl-main__A.odocl $ odoc html-generate --hidden --indent -o html main__A.odocl In Main.A, the source parent of value x should be to Main__A, while the @@ -31,13 +28,13 @@ source parent of value y should be left to B. $ grep source_link html/Main/A/index.html -C 1

Module Main.A - Source + Source

-- - Source - val y : int + Source + val y : int -- - Source - val x : int + Source + val x : int diff --git a/test/sources/lookup_def.t/run.t b/test/sources/lookup_def.t/run.t index 5b912f3730..6a28e6809c 100644 --- a/test/sources/lookup_def.t/run.t +++ b/test/sources/lookup_def.t/run.t @@ -1,31 +1,30 @@ Compile the modules: - $ odoc compile -c module-a -c srctree-source root.mld - - $ printf "a.ml\n" > source_tree.map - $ odoc source-tree -I . --parent page-root -o srctree-source.odoc source_tree.map - $ ocamlc -c a.mli a.ml -bin-annot - $ odoc compile-src --source-path a.ml --parent srctree-source.odoc -I . a.cmt + $ odoc compile-impl --source-id a.ml -I . a.cmt $ odoc compile -I . a.cmti $ odoc link -I . src-a.odoc + odoc: FILE.odoc argument: no 'src-a.odoc' file or directory + Usage: odoc link [--open=MODULE] [OPTION]… FILE.odoc + Try 'odoc link --help' or 'odoc --help' for more information. + [2] $ odoc link -I . a.odoc Show the locations: $ odoc_print a.odocl | jq -c '.. | select(.source_loc?) | [ .id, .source_loc ]' - [{"`Module":[{"`Root":["None","A"]},"M"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":[{"Some":{"`Page":["None","root"]}},"source"]},"a.ml"]},"module-M"]}}] - [{"`Module":[{"`Root":["None","A"]},"N"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":[{"Some":{"`Page":["None","root"]}},"source"]},"a.ml"]},"module-N"]}}] - [{"`ModuleType":[{"`Module":[{"`Root":["None","A"]},"N"]},"S"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":[{"Some":{"`Page":["None","root"]}},"source"]},"a.ml"]},"module-N.module-type-S"]}}] - [{"`Value":[{"`ModuleType":[{"`Module":[{"`Root":["None","A"]},"N"]},"S"]},"x"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":[{"Some":{"`Page":["None","root"]}},"source"]},"a.ml"]},"module-N.module-type-S"]}}] - [{"`Module":[{"`Module":[{"`Root":["None","A"]},"N"]},"T"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":[{"Some":{"`Page":["None","root"]}},"source"]},"a.ml"]},"module-N.module-T"]}}] - [{"`Value":[{"`Module":[{"`Module":[{"`Root":["None","A"]},"N"]},"T"]},"x"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":[{"Some":{"`Page":["None","root"]}},"source"]},"a.ml"]},"module-N.module-T.val-x"]}}] - [{"`Type":[{"`Root":["None","A"]},"t"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":[{"Some":{"`Page":["None","root"]}},"source"]},"a.ml"]},"type-t"]}}] - [{"`Value":[{"`Root":["None","A"]},"a"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":[{"Some":{"`Page":["None","root"]}},"source"]},"a.ml"]},"val-a"]}}] - [{"`Exception":[{"`Root":["None","A"]},"Exn"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":[{"Some":{"`Page":["None","root"]}},"source"]},"a.ml"]},"exception-Exn"]}}] - [{"`Type":[{"`Root":["None","A"]},"ext"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":[{"Some":{"`Page":["None","root"]}},"source"]},"a.ml"]},"type-ext"]}}] - [{"`Extension":[{"`Root":["None","A"]},"Ext"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":[{"Some":{"`Page":["None","root"]}},"source"]},"a.ml"]},"extension-Ext"]}}] - [{"`Class":[{"`Root":["None","A"]},"cls"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":[{"Some":{"`Page":["None","root"]}},"source"]},"a.ml"]},"class-cls"]}}] - [{"`ClassType":[{"`Root":["None","A"]},"clst"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":[{"Some":{"`Page":["None","root"]}},"source"]},"a.ml"]},"class-type-clst"]}}] + [{"`Module":[{"`Root":["None","A"]},"M"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":["None","."]},"a.ml"]},"module-M"]}}] + [{"`Module":[{"`Root":["None","A"]},"N"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":["None","."]},"a.ml"]},"module-N"]}}] + [{"`ModuleType":[{"`Module":[{"`Root":["None","A"]},"N"]},"S"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":["None","."]},"a.ml"]},"module-N.module-type-S"]}}] + [{"`Value":[{"`ModuleType":[{"`Module":[{"`Root":["None","A"]},"N"]},"S"]},"x"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":["None","."]},"a.ml"]},"module-N.module-type-S"]}}] + [{"`Module":[{"`Module":[{"`Root":["None","A"]},"N"]},"T"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":["None","."]},"a.ml"]},"module-N.module-T"]}}] + [{"`Value":[{"`Module":[{"`Module":[{"`Root":["None","A"]},"N"]},"T"]},"x"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":["None","."]},"a.ml"]},"module-N.module-T.val-x"]}}] + [{"`Type":[{"`Root":["None","A"]},"t"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":["None","."]},"a.ml"]},"type-t"]}}] + [{"`Value":[{"`Root":["None","A"]},"a"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":["None","."]},"a.ml"]},"val-a"]}}] + [{"`Exception":[{"`Root":["None","A"]},"Exn"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":["None","."]},"a.ml"]},"exception-Exn"]}}] + [{"`Type":[{"`Root":["None","A"]},"ext"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":["None","."]},"a.ml"]},"type-ext"]}}] + [{"`Extension":[{"`Root":["None","A"]},"Ext"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":["None","."]},"a.ml"]},"extension-Ext"]}}] + [{"`Class":[{"`Root":["None","A"]},"cls"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":["None","."]},"a.ml"]},"class-cls"]}}] + [{"`ClassType":[{"`Root":["None","A"]},"clst"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":["None","."]},"a.ml"]},"class-type-clst"]}}] diff --git a/test/sources/lookup_def_wrapped.t/run.t b/test/sources/lookup_def_wrapped.t/run.t index 70beb38201..5f20524464 100644 --- a/test/sources/lookup_def_wrapped.t/run.t +++ b/test/sources/lookup_def_wrapped.t/run.t @@ -2,34 +2,30 @@ Make sure wrapped libraries don't interfere with generating the source code. Test both canonical paths and hidden units. It's a simpler case than Dune's wrapping. - $ odoc compile -c module-main -c srctree-source root.mld - - $ printf "a.ml\nb.ml\nmain.ml\n" > source_tree.map - $ odoc source-tree -I . --parent page-root -o srctree-source.odoc source_tree.map $ ocamlc -c -o main__A.cmo a.ml -bin-annot -I . $ ocamlc -c -o main__B.cmo b.ml -bin-annot -I . $ ocamlc -c main.ml -bin-annot -I . - $ odoc compile-src --source-path a.ml --parent srctree-source.odoc -I . main__A.cmt + $ odoc compile-impl --source-id a.ml -I . main__A.cmt $ odoc compile -I . main__A.cmt - $ odoc compile-src --source-path b.ml --parent srctree-source.odoc -I . main__B.cmt + $ odoc compile-impl --source-id b.ml -I . main__B.cmt $ odoc compile -I . main__B.cmt - $ odoc compile-src --source-path main.ml --parent srctree-source.odoc -I . main.cmt + $ odoc compile-impl --source-id main.ml -I . main.cmt $ odoc compile -I . main.cmt - $ odoc link -I . src-main__A.odoc + $ odoc link -I . impl-main__A.odoc $ odoc link -I . main__A.odoc - $ odoc link -I . src-main__B.odoc + $ odoc link -I . impl-main__B.odoc $ odoc link -I . main__B.odoc - $ odoc link -I . src-main.odoc + $ odoc link -I . impl-main.odoc $ odoc link -I . main.odoc - $ odoc html-generate --source main.ml --indent -o html src-main.odocl + $ odoc html-generate --source main.ml --indent -o html impl-main.odocl $ odoc html-generate --indent -o html main.odocl - $ odoc html-generate --source a.ml --indent -o html src-main__A.odocl + $ odoc html-generate --source a.ml --indent -o html impl-main__A.odocl $ odoc html-generate --hidden --indent -o html main__A.odocl - $ odoc html-generate --source b.ml --indent -o html src-main__B.odocl + $ odoc html-generate --source b.ml --indent -o html impl-main__B.odocl $ odoc html-generate --hidden --indent -o html main__B.odocl Look if all the source files are generated: @@ -46,11 +42,9 @@ Look if all the source files are generated: html/Main__A/index.html html/Main__B html/Main__B/index.html - html/root - html/root/source - html/root/source/a.ml.html - html/root/source/b.ml.html - html/root/source/main.ml.html + html/a.ml.html + html/b.ml.html + html/main.ml.html $ cat html/Main/A/index.html @@ -68,15 +62,15 @@ Look if all the source files are generated:

Module Main.A - Source + Source

- Source - val x : int + Source + val x : int
diff --git a/test/sources/recursive_module.t/run.t b/test/sources/recursive_module.t/run.t index 835df6bdd6..8576d141f8 100644 --- a/test/sources/recursive_module.t/run.t +++ b/test/sources/recursive_module.t/run.t @@ -1,30 +1,25 @@ Checking that source links exists inside recursive modules. - $ odoc compile -c module-main -c srctree-source root.mld - - $ printf "main.ml" > source_tree.map - $ odoc source-tree -I . --parent page-root -o srctree-source.odoc source_tree.map - $ ocamlc -c main.ml -bin-annot -I . - $ odoc compile-src --source-path main.ml --parent srctree-source.odoc -I . main.cmt + $ odoc compile-impl --source-id main.ml -I . main.cmt $ odoc compile -I . main.cmt - $ odoc link -I . src-main.odoc + $ odoc link -I . impl-main.odoc $ odoc link -I . main.odoc $ odoc html-generate --indent -o html main.odocl - $ odoc html-generate --source main.ml --indent -o html src-main.odocl + $ odoc html-generate --source main.ml --indent -o html impl-main.odocl Both modules should contain source links $ grep source_link html/Main/A/index.html -C 2

Module Main.A - - Source - + Source +

+
$ grep source_link html/Main/B/index.html -C 2

Module Main.B - - Source - + Source +

+
diff --git a/test/sources/single_mli.t/run.t b/test/sources/single_mli.t/run.t index 101b4adb40..a9ff2394e3 100644 --- a/test/sources/single_mli.t/run.t +++ b/test/sources/single_mli.t/run.t @@ -1,27 +1,22 @@ Similar to Astring library. - $ odoc compile -c module-a -c srctree-source root.mld - - $ printf "a.ml\na_x.ml\n" > source_tree.map - $ odoc source-tree -I . --parent page-root -o srctree-source.odoc source_tree.map - $ ocamlc -c -o a_x.cmo a_x.ml -bin-annot -I . $ ocamlc -c a.mli -bin-annot -I . $ ocamlc -c a.ml -bin-annot -I . - $ odoc compile-src --source-path a_x.ml --parent srctree-source.odoc -I . a_x.cmt + $ odoc compile-impl --source-id a_x.ml -I . a_x.cmt $ odoc compile --hidden -I . a_x.cmt - $ odoc compile-src --source-path a.ml --parent srctree-source.odoc -I . a.cmt + $ odoc compile-impl --source-id a.ml -I . a.cmt $ odoc compile -I . a.cmti - $ odoc link -I . src-a_x.odoc + $ odoc link -I . impl-a_x.odoc $ odoc link -I . a_x.odoc - $ odoc link -I . src-a.odoc + $ odoc link -I . impl-a.odoc $ odoc link -I . a.odoc - $ odoc html-generate --source a_x.ml --indent -o html src-a_x.odocl + $ odoc html-generate --source a_x.ml --indent -o html impl-a_x.odocl $ odoc html-generate --indent -o html a_x.odocl - $ odoc html-generate --source a.ml --indent -o html src-a.odocl + $ odoc html-generate --source a.ml --indent -o html impl-a.odocl $ odoc html-generate --indent -o html a.odocl Look if all the source files are generated: @@ -36,10 +31,8 @@ Look if all the source files are generated: html/A/index.html html/A_x html/A_x/index.html - html/root - html/root/source - html/root/source/a.ml.html - html/root/source/a_x.ml.html + html/a.ml.html + html/a_x.ml.html Documentation for `A_x` is not generated for hidden modules: @@ -49,18 +42,19 @@ Documentation for `A_x` is not generated for hidden modules: Code source for `A_x` is wanted: $ [ -f html/root/source/a_x.ml.html ] + [1] `A` should contain a link to `A_x.ml.html`: $ grep source_link html/A/index.html - Source - Source + Source + Source `A.X` and `A.X.Y` should contain a link to `A_x.ml.html`: $ grep source_link html/A/X/index.html - Source - + Source + Source $ grep source_link html/A/X/Y/index.html - - class="source_link">Source + Source + diff --git a/test/sources/source.t/run.t b/test/sources/source.t/run.t index f2e1303d3c..f640821ad5 100644 --- a/test/sources/source.t/run.t +++ b/test/sources/source.t/run.t @@ -88,29 +88,18 @@ Files containing some values: let string2 = "truc" -Source pages require a parent: - - $ odoc compile -c module-a -c srctree-source -c srctree-source2 root.mld - Compile the modules: $ ocamlc -c a.ml -bin-annot Compile the pages with the --source option: - $ printf "a.ml\n" > source_tree.map - $ odoc source-tree -I . --parent page-root -o srctree-source.odoc source_tree.map - - $ odoc compile-src -I . --source-path a.ml --parent srctree-source.odoc a.cmt + $ odoc compile-impl -I . --source-id a.ml a.cmt $ odoc compile -I . a.cmt $ odoc link -I . a.odoc - $ odoc link -I . src-a.odoc - $ odoc link -I . page-root.odoc - $ odoc link -I . srctree-source.odoc - $ odoc html-generate --indent -o html srctree-source.odocl - $ odoc html-generate --indent -o html page-root.odocl + $ odoc link -I . impl-a.odoc $ odoc html-generate --indent -o html a.odocl - $ odoc html-generate --source a.ml --indent -o html src-a.odocl + $ odoc html-generate --source a.ml --indent -o html impl-a.odocl $ odoc support-files -o html Source links generated in the documentation: @@ -118,143 +107,143 @@ Source links generated in the documentation: $ grep source_link html/A/index.html -B 2

Module A - Source + Source --
- Source + Source --
- Source + Source --
- Source + Source --
- + Source --
- Source + Source --
- Source + Source --
- Source + Source --
- Source + Source --
- Source + Source --
- Source + Source --
- + Source --
- + Source --
- Source + Source --
- + Source --
- + Source --
- Source + Source --
- Source + Source --
- + Source --
- Source + Source --
- Source + Source --
- Source + Source --
- Source + Source --
- Source + Source --
- Source + Source --
- Source + Source --
- Source + Source --
- Source + Source --
- Source + Source --
- Source + Source --
- Source + Source --
- Source + Source --
- Source + Source --
- + Source Ids generated in the source code: - $ cat html/root/source/a.ml.html | tr '> ' '\n\n' | grep '^id' + $ cat html/a.ml.html | tr '> ' '\n\n' | grep '^id' id="L1" id="L2" id="L3" diff --git a/test/sources/source_hierarchy.t/run.t b/test/sources/source_hierarchy.t/run.t index bab63ee873..8b72b6919f 100644 --- a/test/sources/source_hierarchy.t/run.t +++ b/test/sources/source_hierarchy.t/run.t @@ -1,10 +1,3 @@ -A page can have source children. - - $ odoc compile -c module-a -c module-b -c srctree-source root.mld - - $ printf "lib/main.ml\nlib/b/b.ml\nlib/a/a.ml\n" > source.map - $ odoc source-tree -I . --parent page-root source.map - Compile the modules: $ ocamlc -c a.ml -bin-annot @@ -13,27 +6,23 @@ Compile the modules: Now, compile the pages with the --source option. The source-name must be included in the source-children of the source-parent: - $ odoc compile-src -I . --source-path lib/a/a.ml --parent srctree-source.odoc a.cmt + $ odoc compile-impl -I . --source-id lib/a/a.ml a.cmt $ odoc compile -I . a.cmt - $ odoc compile-src -I . --source-path lib/b/b.ml --parent srctree-source.odoc b.cmt + $ odoc compile-impl -I . --source-id lib/b/b.ml b.cmt $ odoc compile -I . b.cmt - $ odoc compile-src -I . --source-path lib/main.ml --parent srctree-source.odoc c.cmt + $ odoc compile-impl -I . --source-id lib/main.ml c.cmt $ odoc compile -I . c.cmt - $ odoc link -I . page-root.odoc $ odoc link -I . a.odoc $ odoc link -I . b.odoc $ odoc link -I . c.odoc - $ odoc link -I . src-a.odoc - $ odoc link -I . src-b.odoc - $ odoc link -I . src-c.odoc - $ odoc link -I . srctree-source.odoc - $ odoc html-generate --indent -o html page-root.odocl - $ odoc html-generate --indent -o html srctree-source.odocl - $ odoc html-generate --source a.ml --indent -o html src-a.odocl + $ odoc link -I . impl-a.odoc + $ odoc link -I . impl-b.odoc + $ odoc link -I . impl-c.odoc + $ odoc html-generate --source a.ml --indent -o html impl-a.odocl $ odoc html-generate --indent -o html a.odocl - $ odoc html-generate --source b.ml --indent -o html src-b.odocl + $ odoc html-generate --source b.ml --indent -o html impl-b.odocl $ odoc html-generate --indent -o html b.odocl - $ odoc html-generate --source c.ml --indent -o html src-c.odocl + $ odoc html-generate --source c.ml --indent -o html impl-c.odocl $ odoc html-generate --indent -o html c.odocl Source pages and source directory pages are generated: @@ -46,44 +35,10 @@ Source pages and source directory pages are generated: html/B/index.html html/C html/C/index.html - html/root - html/root/index.html - html/root/source - html/root/source/index.html - html/root/source/lib - html/root/source/lib/a - html/root/source/lib/a/a.ml.html - html/root/source/lib/a/index.html - html/root/source/lib/b - html/root/source/lib/b/b.ml.html - html/root/source/lib/b/index.html - html/root/source/lib/index.html - html/root/source/lib/main.ml.html - -A directory simply list its children: + html/lib + html/lib/a + html/lib/a/a.ml.html + html/lib/b + html/lib/b/b.ml.html + html/lib/main.ml.html - $ cat html/root/source/lib/index.html - - - lib (root.source.lib) - - - - - - - -
-

./lib/

- -
- - diff --git a/test/sources/source_hierarchy_source_root.t/run.t b/test/sources/source_hierarchy_source_root.t/run.t index 22903d728f..43f3490142 100644 --- a/test/sources/source_hierarchy_source_root.t/run.t +++ b/test/sources/source_hierarchy_source_root.t/run.t @@ -1,10 +1,3 @@ -A page can have source children. - - $ odoc compile -c module-a -c module-b -c srctree-source root.mld - - $ printf "lib/main.ml\nlib/b/b.ml\nlib/a/a.ml\n" > source.map - $ odoc source-tree -I . --parent page-root source.map - Compile the modules: $ ocamlc -c lib/a/a.ml -bin-annot @@ -13,28 +6,24 @@ Compile the modules: Now, compile the pages with the --source option. The source-name must be included in the source-children of the source-parent: - $ odoc compile-src -I . --source-path lib/a/a.ml --parent srctree-source.odoc lib/a/a.cmt - $ odoc compile -I . lib/a/a.cmt - $ odoc compile-src -I . --source-path lib/b/b.ml --parent srctree-source.odoc lib/b/b.cmt - $ odoc compile -I . lib/b/b.cmt - $ odoc compile-src -I . --source-path lib/main.ml --parent srctree-source.odoc lib/main.cmt - $ odoc compile -I . lib/main.cmt - $ odoc link -I . -I lib/a -I lib/b -I lib page-root.odoc - $ odoc link -I . lib/a/a.odoc - $ odoc link -I . lib/b/b.odoc - $ odoc link -I . lib/main.odoc - $ odoc link -I . lib/a/src-a.odoc - $ odoc link -I . lib/b/src-b.odoc - $ odoc link -I . lib/src-main.odoc - $ odoc link -I . srctree-source.odoc - $ odoc html-generate --indent -o html page-root.odocl - $ odoc html-generate --indent -o html srctree-source.odocl - $ odoc html-generate --source-root . --indent -o html lib/a/src-a.odocl - $ odoc html-generate --indent -o html lib/a/a.odocl - $ odoc html-generate --source-root . --indent -o html lib/b/src-b.odocl - $ odoc html-generate --indent -o html lib/b/b.odocl - $ odoc html-generate --indent -o html lib/main.odocl - $ odoc html-generate --source-root . --indent -o html lib/src-main.odocl + $ odoc compile-impl -I . --source-id lib/a/a.ml lib/a/a.cmt + $ odoc compile -I . lib/a/a.cmt -o a.odoc + $ odoc compile-impl -I . --source-id lib/b/b.ml lib/b/b.cmt + $ odoc compile -I . lib/b/b.cmt -o b.odoc + $ odoc compile-impl -I . --source-id lib/main.ml lib/main.cmt + $ odoc compile -I . lib/main.cmt -o main.odoc + $ odoc link -I . a.odoc + $ odoc link -I . b.odoc + $ odoc link -I . main.odoc + $ odoc link -I . impl-a.odoc + $ odoc link -I . impl-b.odoc + $ odoc link -I . impl-main.odoc + $ odoc html-generate --source lib/a/a.ml --indent -o html impl-a.odocl + $ odoc html-generate --indent -o html a.odocl + $ odoc html-generate --source lib/b/b.ml --indent -o html impl-b.odocl + $ odoc html-generate --indent -o html b.odocl + $ odoc html-generate --indent -o html main.odocl + $ odoc html-generate --source lib/main.ml --indent -o html impl-main.odocl Source pages and source directory pages are generated: @@ -46,44 +35,9 @@ Source pages and source directory pages are generated: html/B/index.html html/Main html/Main/index.html - html/root - html/root/index.html - html/root/source - html/root/source/index.html - html/root/source/lib - html/root/source/lib/a - html/root/source/lib/a/a.ml.html - html/root/source/lib/a/index.html - html/root/source/lib/b - html/root/source/lib/b/b.ml.html - html/root/source/lib/b/index.html - html/root/source/lib/index.html - html/root/source/lib/main.ml.html - -A directory simply list its children: - - $ cat html/root/source/lib/index.html - - - lib (root.source.lib) - - - - - - - -
-

./lib/

- -
- - + html/lib + html/lib/a + html/lib/a/a.ml.html + html/lib/b + html/lib/b/b.ml.html + html/lib/main.ml.html