diff --git a/CHANGES.md b/CHANGES.md index 7d9f0d96..891d0ae5 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -66,6 +66,9 @@ next whether a multi valued variable is allowed is determined by the quoting and substitution context it appears in. (#849, fix #701, @rgrinberg) +- Fix documentation generation for private libraries. (#864, fix #856, + @rgrinberg) + 1.0+beta20 (10/04/2018) ----------------------- diff --git a/src/odoc.ml b/src/odoc.ml index d4e7bfc6..58a32a19 100644 --- a/src/odoc.ml +++ b/src/odoc.ml @@ -22,10 +22,20 @@ type target = | Lib of Lib.t | Pkg of Package.Name.t +type source = Module | Mld + +type odoc = + { odoc_input: Path.t + ; html_dir: Path.t + ; html_file: Path.t + ; source: source + } + module Gen (S : sig val sctx : SC.t end) = struct open S let context = SC.context sctx + let stanzas = SC.stanzas sctx module Paths = struct let root = context.Context.build_dir ++ "_doc" @@ -138,14 +148,6 @@ module Gen (S : sig val sctx : SC.t end) = struct ]); odoc_file - type odoc = - { odoc_input: Path.t - ; html_dir: Path.t - ; html_file: Path.t - ; html_alias: Build_system.Alias.t - ; typ: [`Module | `Mld] - } - let odoc_include_flags requires = Arg_spec.of_result_map requires ~f:(fun libs -> let paths = @@ -159,11 +161,12 @@ module Gen (S : sig val sctx : SC.t end) = struct Arg_spec.S (List.concat_map (Path.Set.to_list paths) ~f:(fun dir -> [Arg_spec.A "-I"; Path dir]))) - let to_html (odoc_file : odoc) ~deps ~requires = + let setup_html (odoc_file : odoc) ~requires = + let deps = Dep.deps requires in let to_remove, jbuilder_keep = - match odoc_file.typ with - | `Mld -> odoc_file.html_file, [] - | `Module -> + match odoc_file.source with + | Mld -> odoc_file.html_file, [] + | Module -> let jbuilder_keep = Build.create_file (odoc_file.html_dir ++ Config.jbuilder_keep_fname) in odoc_file.html_dir, [jbuilder_keep] @@ -182,10 +185,7 @@ module Gen (S : sig val sctx : SC.t end) = struct ; Dep odoc_file.odoc_input ; Hidden_targets [odoc_file.html_file] ] - :: jbuilder_keep - ) - ); - odoc_file.html_file + :: jbuilder_keep)) let css_file = Paths.html_root ++ "odoc.css" @@ -259,12 +259,6 @@ module Gen (S : sig val sctx : SC.t end) = struct in SC.add_rule sctx @@ Build.write_file toplevel_index html - - let html_alias pkg = - Build_system.Alias.doc ~dir:( - Path.append context.build_dir pkg.Package.path - ) - let libs_of_pkg ~pkg = match Package.Name.Map.find (SC.libs_by_package sctx) pkg with | None -> Lib.Set.empty @@ -278,7 +272,6 @@ module Gen (S : sig val sctx : SC.t end) = struct pkg_libs let create_odoc ~target odoc_input = - let html_alias = Dep.html_alias target in let html_base = Paths.html target in match target with | Lib _ -> @@ -291,8 +284,7 @@ module Gen (S : sig val sctx : SC.t end) = struct { odoc_input ; html_dir ; html_file = html_dir ++ "index.html" - ; typ = `Module - ; html_alias + ; source = Module } | Pkg _ -> { odoc_input @@ -303,52 +295,48 @@ module Gen (S : sig val sctx : SC.t end) = struct |> String.drop_prefix ~prefix:"page-" |> Option.value_exn ) - ; typ = `Mld - ; html_alias + ; source = Mld } + let static_html = [ css_file; toplevel_index ] + + let odocs = + let odoc_glob = + Re.compile (Re.seq [Re.(rep1 any) ; Re.str ".odoc" ; Re.eos]) in + fun target -> + let dir = Paths.odocs target in + SC.eval_glob sctx ~dir odoc_glob + |> List.map ~f:(fun d -> create_odoc (Path.relative dir d) ~target) + + let setup_lib_html_rules = + let loaded = ref Lib.Set.empty in + fun lib ~requires -> + if not (Lib.Set.mem !loaded lib) then begin + loaded := Lib.Set.add !loaded lib; + let odocs = odocs (Lib lib) in + List.iter odocs ~f:(setup_html ~requires); + let html_files = List.map ~f:(fun o -> o.html_file) odocs in + SC.add_alias_deps sctx (Dep.html_alias (Lib lib)) + (Path.Set.of_list (List.rev_append static_html html_files)); + end + let setup_pkg_html_rules = let loaded = Package.Name.Table.create ~default_value:false in - let odoc_glob = - Re.compile (Re.seq [Re.(rep1 any) ; Re.str ".odoc" ; Re.eos]) in fun ~pkg ~libs -> if not (Package.Name.Table.get loaded pkg) then begin Package.Name.Table.set loaded ~key:pkg ~data:true; + let requires = Lib.closure libs in + List.iter libs ~f:(setup_lib_html_rules ~requires); + let pkg_odocs = odocs (Pkg pkg) in + List.iter pkg_odocs ~f:(setup_html ~requires); let odocs = - let odocs target = - let dir = Paths.odocs target in - SC.eval_glob sctx ~dir odoc_glob - |> List.map ~f:(fun d -> create_odoc (Path.relative dir d) ~target) - in List.concat ( - odocs (Pkg pkg) + pkg_odocs :: (List.map libs ~f:(fun lib -> odocs (Lib lib))) ) in - let html_files = - let closure = - match Lib.closure libs with - | Ok closure -> closure - | Error _ -> - (* CR diml for rgrinberg: this branch needs a comment, I - don't understand why we fallback to not taking the - transitive closure in case of error. *) - libs - in - let deps = Dep.deps (Ok closure) in - List.map odocs ~f:(to_html ~deps ~requires:(Ok closure)) in - List.iter ( - Dep.html_alias (Pkg pkg) - :: List.map ~f:(fun lib -> Dep.html_alias (Lib lib)) libs - ) ~f:(fun alias -> - SC.add_alias_deps sctx alias - (Path.Set.of_list [ css_file - ; toplevel_index - ]) - ); - List.combine odocs html_files - |> List.iter ~f:(fun (odoc, html) -> - SC.add_alias_deps sctx odoc.html_alias (Path.Set.singleton html) - ); + let html_files = List.map ~f:(fun o -> o.html_file) odocs in + SC.add_alias_deps sctx (Dep.html_alias (Pkg pkg)) + (Path.Set.of_list (List.rev_append static_html html_files)) end let gen_rules ~dir:_ rest = @@ -366,25 +354,31 @@ module Gen (S : sig val sctx : SC.t end) = struct | Ok lib -> SC.load_dir sctx ~dir:(Lib.src_dir lib) end | "_html" :: lib_unique_name_or_pkg :: _ -> - let setup_html_rules pkg = - setup_pkg_html_rules ~pkg ~libs:( - Lib.Set.to_list (load_all_odoc_rules_pkg ~pkg) - ) in (* TODO we can be a better with the error handling in the case where lib_unique_name_or_pkg is neither a valid pkg or lnu *) let lib, lib_db = SC.Scope_key.of_string sctx lib_unique_name_or_pkg in + let setup_pkg_html_rules pkg = + setup_pkg_html_rules ~pkg ~libs:( + Lib.Set.to_list (load_all_odoc_rules_pkg ~pkg)) in begin match Lib.DB.find lib_db lib with | Error _ -> () - | Ok lib -> Option.iter (Lib.package lib) ~f:setup_html_rules + | Ok lib -> + begin match Lib.package lib with + | None -> setup_lib_html_rules lib ~requires:(Lib.closure [lib]) + | Some pkg -> setup_pkg_html_rules pkg + end end; Option.iter (Package.Name.Map.find (SC.packages sctx) (Package.Name.of_string lib_unique_name_or_pkg)) - ~f:(fun pkg -> setup_html_rules pkg.name) + ~f:(fun pkg -> setup_pkg_html_rules pkg.name) | _ -> () let setup_package_aliases (pkg : Package.t) = - let alias = html_alias pkg in + let alias = + Build_system.Alias.doc ~dir:( + Path.append context.build_dir pkg.Package.path + ) in SC.add_alias_deps sctx alias ( Dep.html_alias (Pkg pkg.name) :: (libs_of_pkg ~pkg:pkg.name @@ -468,7 +462,7 @@ module Gen (S : sig val sctx : SC.t end) = struct let init ~modules_by_lib ~mlds_of_dir = let docs_by_package = let map = lazy ( - SC.stanzas sctx + stanzas |> List.concat_map ~f:(fun (w : SC.Dir_with_jbuild.t) -> List.filter_map w.stanzas ~f:(function | Documentation (d : Jbuild.Documentation.t) -> @@ -491,7 +485,7 @@ module Gen (S : sig val sctx : SC.t end) = struct | o -> o end) in let lib_to_library = lazy ( - SC.stanzas sctx + stanzas |> List.concat_map ~f:(fun (w : SC.Dir_with_jbuild.t) -> List.filter_map w.stanzas ~f:(function | Jbuild.Library (l : Library.t) -> @@ -529,7 +523,7 @@ module Gen (S : sig val sctx : SC.t end) = struct Super_context.add_alias_deps sctx (Build_system.Alias.private_doc ~dir:context.build_dir) - (SC.stanzas sctx + (stanzas |> List.concat_map ~f:(fun (w : SC.Dir_with_jbuild.t) -> List.filter_map w.stanzas ~f:(function | Jbuild.Library (l : Jbuild.Library.t) -> @@ -544,7 +538,7 @@ module Gen (S : sig val sctx : SC.t end) = struct | _ -> None )) |> List.map ~f:(fun (lib : Lib.t) -> - Build_system.Alias.stamp_file (Dep.alias (Lib lib))) + Build_system.Alias.stamp_file (Dep.html_alias (Lib lib))) |> Path.Set.of_list ) diff --git a/test/blackbox-tests/test-cases/multiple-private-libs/run.t b/test/blackbox-tests/test-cases/multiple-private-libs/run.t index d4ca8166..95d7a978 100644 --- a/test/blackbox-tests/test-cases/multiple-private-libs/run.t +++ b/test/blackbox-tests/test-cases/multiple-private-libs/run.t @@ -1,9 +1,12 @@ This test checks that there is no clash when two private libraries have the same name $ dune build --display short @doc-private + odoc _doc/_html/odoc.css ocamldep a/test.ml.d ocamlc a/.test.objs/test.{cmi,cmo,cmt} odoc _doc/_odoc/lib/test@a/test.odoc + odoc _doc/_html/test@a/Test/.jbuilder-keep,_doc/_html/test@a/Test/index.html ocamldep b/test.ml.d ocamlc b/.test.objs/test.{cmi,cmo,cmt} odoc _doc/_odoc/lib/test@b/test.odoc + odoc _doc/_html/test@b/Test/.jbuilder-keep,_doc/_html/test@b/Test/index.html