diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 72564e66..ef0694a5 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -11,6 +11,8 @@ open! No_io module Gen(P : Install_rules.Params) = struct module Alias = Build_system.Alias module SC = Super_context + module Odoc = Odoc.Gen(P) + open P let ctx = SC.context sctx @@ -760,13 +762,7 @@ module Gen(P : Install_rules.Params) = struct SC.add_rule sctx build ); - (* Odoc *) - let mld_files = - String_set.fold files ~init:[] ~f:(fun fn acc -> - if Filename.check_suffix fn ".mld" then fn :: acc else acc) - in - Odoc.setup_library_rules sctx lib ~dir ~requires ~modules ~dep_graphs - ~mld_files ~scope + Odoc.setup_library_odoc_rules lib ~dir ~requires ~modules ~dep_graphs ~scope ; let flags = @@ -983,7 +979,7 @@ module Gen(P : Install_rules.Params) = struct (match components with | ".js" :: rest -> Js_of_ocaml_rules.setup_separate_compilation_rules sctx rest - | "_doc" :: rest -> Odoc.gen_rules sctx rest ~dir + | "_doc" :: rest -> Odoc.gen_rules rest ~dir | ".ppx" :: rest -> Preprocessing.gen_rules sctx rest | _ -> match Path.Map.find stanzas_per_dir dir with @@ -1006,7 +1002,13 @@ module Gen(P : Install_rules.Params) = struct let module_names_of_lib = module_names_of_lib let mlds_of_dir = mlds_of_dir end) in - Install_rules.init () + Install_rules.init (); + Odoc.init ~modules_by_lib:(fun ~dir lib -> + let m = modules_by_lib ~dir lib in + match m.alias_module with + | Some m -> [m] + | None -> Module.Name.Map.values m.modules + ) ~mlds_of_dir end module type Gen = sig diff --git a/src/odoc.boot.ml b/src/odoc.boot.ml new file mode 100644 index 00000000..fe731c5b --- /dev/null +++ b/src/odoc.boot.ml @@ -0,0 +1,10 @@ + +module Gen (S : sig val sctx : Super_context.t end) = struct + + let setup_library_odoc_rules _ ~dir:_ ~scope:_ ~modules:_ ~requires:_ + ~dep_graphs:_ = () + + let init ~modules_by_lib:_ ~mlds_of_dir:_ = () + + let gen_rules ~dir:_ _ = () +end diff --git a/src/odoc.ml b/src/odoc.ml index 6b665833..ee8b4a19 100644 --- a/src/odoc.ml +++ b/src/odoc.ml @@ -4,113 +4,100 @@ open Build.O module SC = Super_context -module Doc = struct - let root sctx = Path.relative (SC.context sctx).Context.build_dir "_doc" +let (++) = Path.relative - type origin = - | Public of string - | Private of string * Scope_info.Name.t +let lib_unique_name lib = + let name = Lib.name lib in + match Lib.status lib with + | Installed -> assert false + | Public _ -> name + | Private scope_name -> SC.Scope_key.to_string name scope_name - let dir_internal t origin = - let name = - match origin with - | Public n -> n - | Private (n, s) -> sprintf "%s@%s" n (Scope_info.Name.to_string s) - in - Path.relative (root t) name +let pkg_or_lnu lib = + match Lib.package lib with + | Some p -> Package.Name.to_string p + | None -> lib_unique_name lib - let dir t (lib : Library.t) = - dir_internal t - (match lib.public with - | Some { name; _ } -> Public name - | None -> Private (lib.name, lib.scope_name)) +type target = + | Lib of Lib.t + | Pkg of Package.Name.t - let alias = Build_system.Alias.make ".doc-all" +module Gen (S : sig val sctx : SC.t end) = struct + open S - let deps t = - Build.dyn_paths (Build.arr ( - List.fold_left ~init:[] ~f:(fun acc (lib : Lib.t) -> - if Lib.is_local lib then ( - let dir = - dir_internal t - (match Lib.status lib with - | Installed -> assert false - | Public _ -> Public (Lib.name lib) - | Private s -> Private (Lib.name lib, s)) - in - Build_system.Alias.stamp_file (alias ~dir) :: acc - ) else ( - acc - ) - ))) + let context = SC.context sctx - let alias t lib = alias ~dir:(dir t lib) + module Paths = struct + let root = context.Context.build_dir ++ "_doc" - let static_deps t lib = Build_system.Alias.dep (alias t lib) + let odocs m = + root ++ ( + match m with + | Lib lib -> sprintf "_odoc/lib/%s" (lib_unique_name lib) + | Pkg pkg -> sprintf "_odoc/pkg/%s" (Package.Name.to_string pkg) + ) - let setup_deps t lib files = SC.add_alias_deps t (alias t lib) files + let html_root = root ++ "_html" - let dir t lib = dir t lib -end + let html m = + html_root ++ ( + match m with + | Pkg pkg -> Package.Name.to_string pkg + | Lib lib -> pkg_or_lnu lib + ) + let gen_mld_dir (pkg : Package.t) = + root ++ "_mlds" ++ (Package.Name.to_string pkg.name) + end -let ( ++ ) = Path.relative + module Dep = struct + let html_alias m = + Build_system.Alias.doc ~dir:(Paths.html m) -let get_odoc sctx = SC.resolve_program sctx "odoc" ~hint:"opam install odoc" -let odoc_ext = ".odoc" + let alias = Build_system.Alias.make ".odoc-all" -module Mld : sig - type t - val create : name:string -> t + let deps = + Build.dyn_paths (Build.arr ( + List.fold_left ~init:[] ~f:(fun acc (lib : Lib.t) -> + if Lib.is_local lib then ( + let dir = Paths.odocs (Lib lib) in + Build_system.Alias.stamp_file (alias ~dir) :: acc + ) else ( + acc + ) + ))) - val odoc_file : doc_dir:Path.t -> t -> Path.t - val odoc_input : doc_dir:Path.t -> t -> Path.t + let alias m = alias ~dir:(Paths.odocs m) - val html_filename : t -> string -end = struct - type t = string (** source file name without the extension. *) + (* let static_deps t lib = Build_system.Alias.dep (alias t lib) *) - let create ~name = name + let setup_deps m files = SC.add_alias_deps sctx (alias m) files + end - let odoc_file ~doc_dir t = - Path.relative doc_dir (sprintf "page-%s%s" t odoc_ext) + let odoc = SC.resolve_program sctx "odoc" ~hint:"opam install odoc" + let odoc_ext = ".odoc" - let odoc_input ~doc_dir t = - Path.relative doc_dir (sprintf "%s-generated.mld" t) + module Mld : sig + type t - let html_filename t = - sprintf "%s.html" t -end + val create : Path.t -> t -module Module_or_mld = struct - type t = - | Mld of Mld.t - | Module of Module.t + val odoc_file : doc_dir:Path.t -> t -> Path.t + val odoc_input : t -> Path.t - let odoc_file ~doc_dir = function - | Mld m -> Mld.odoc_file ~doc_dir m - | Module m -> Module.odoc_file ~doc_dir m + end = struct + type t = Path.t - let odoc_input ~obj_dir ~doc_dir = function - | Mld m -> Mld.odoc_input ~doc_dir m - | Module m -> Module.cmti_file m ~obj_dir + let create p = p - let html_dir ~doc_dir = function - | Mld _ -> doc_dir - | Module m -> doc_dir ++ String.capitalize m.obj_name + let odoc_file ~doc_dir t = + let t = Filename.chop_extension (Path.basename t) in + Path.relative doc_dir (sprintf "page-%s%s" t odoc_ext) - let html_file ~doc_dir t = - match t with - | Mld m -> html_dir ~doc_dir t ++ Mld.html_filename m - | Module _ -> html_dir ~doc_dir t ++ "index.html" -end + let odoc_input t = t + end -let module_or_mld_deps (m : Module_or_mld.t) ~doc_dir - ~(dep_graphs:Ocamldep.Dep_graphs.t) = - match m with - | Mld _ -> - Build.arr (fun x -> x) - | Module m -> + let module_deps (m : Module.t) ~doc_dir ~(dep_graphs:Ocamldep.Dep_graphs.t) = Build.dyn_paths ((match m.intf with | Some _ -> @@ -120,194 +107,140 @@ let module_or_mld_deps (m : Module_or_mld.t) ~doc_dir Ocamldep.Dep_graph.deps_of dep_graphs.impl m) >>^ List.map ~f:(Module.odoc_file ~doc_dir)) -let compile sctx (m : Module_or_mld.t) ~odoc ~dir ~obj_dir ~includes ~dep_graphs - ~doc_dir ~lib_unique_name = - let context = SC.context sctx in - let odoc_file = Module_or_mld.odoc_file m ~doc_dir in - SC.add_rule sctx - (module_or_mld_deps m ~doc_dir ~dep_graphs - >>> - includes - >>> - Build.run ~context ~dir:doc_dir odoc - [ A "compile" - ; A "-I"; Path dir - ; Dyn (fun x -> x) - ; As ["--pkg"; lib_unique_name] - ; A "-o"; Target odoc_file - ; Dep (Module_or_mld.odoc_input m ~obj_dir ~doc_dir) - ]); - (m, odoc_file) - -let to_html sctx (m : Module_or_mld.t) odoc_file ~doc_dir ~odoc ~dir ~includes - ~(lib : Library.t) = - let context = SC.context sctx in - let html_dir = Module_or_mld.html_dir ~doc_dir m in - let html_file = Module_or_mld.html_file ~doc_dir m in - let to_remove, jbuilder_keep = - match m with - | Mld _ -> html_file, [] - | Module _ -> - let jbuilder_keep = - Build.create_file (html_dir ++ Config.jbuilder_keep_fname) in - html_dir, [jbuilder_keep] - in - SC.add_rule sctx - (Doc.static_deps sctx lib - >>> - includes - >>> - Build.progn ( - Build.remove_tree to_remove - :: Build.mkdir html_dir - :: Build.run ~context ~dir odoc ~extra_targets:[html_file] - [ A "html" - ; A "-I"; Path doc_dir - ; Dyn (fun x -> x) - ; A "-o"; Path (Path.parent doc_dir) - ; Dep odoc_file - ] - :: jbuilder_keep - ) - ); - html_file - -let all_mld_files sctx ~(lib : Library.t) ~modules ~dir files = - let all_files = - if List.mem "index.mld" ~set:files then files else "index.mld" :: files - in - let lib_name = Library.best_name lib in - let doc_dir = Doc.dir sctx lib in - List.map all_files ~f:(fun file -> - let name = Filename.chop_extension file in - let mld = Mld.create ~name in - let generated_mld = Mld.odoc_input ~doc_dir mld in - let source_mld = dir ++ file in + let compile_module (m : Module.t) ~dir ~obj_dir ~includes ~dep_graphs + ~doc_dir ~pkg_or_lnu = + let odoc_file = Module.odoc_file m ~doc_dir in SC.add_rule sctx - (Build.if_file_exists source_mld - ~then_:(Build.contents source_mld) - ~else_:(Build.arr (fun () -> - (if lib.wrapped then - sprintf - "{1 Library %s}\n\ - The entry point for this library is module {!module:%s}." - lib_name - (String.capitalize lib.name) - else - sprintf - "{1 Library %s}\n\ - This library exposes the following toplevel modules: {!modules:%s}." - lib_name - ((Module.Name.Map.keys modules :> string list) - |> String.concat ~sep:" ")))) + (module_deps m ~doc_dir ~dep_graphs >>> - Build.write_file_dyn generated_mld); - mld - ) + includes + >>> + Build.run ~context ~dir:doc_dir odoc + [ A "compile" + ; A "-I"; Path dir + ; Dyn (fun x -> x) + ; As ["--pkg"; pkg_or_lnu] + ; A "-o"; Target odoc_file + ; Dep (Module.cmti_file m ~obj_dir) + ]); + (m, odoc_file) -let css_file ~doc_dir = doc_dir ++ "odoc.css" + let compile_mld (m : Mld.t) ~includes ~doc_dir ~pkg = + let odoc_file = Mld.odoc_file m ~doc_dir in + SC.add_rule sctx + (includes + >>> + Build.run ~context ~dir:doc_dir odoc + [ A "compile" + ; Dyn (fun x -> x) + ; As ["--pkg"; Package.Name.to_string pkg] + ; A "-o"; Target odoc_file + ; Dep (Mld.odoc_input m) + ]); + odoc_file -let toplevel_index ~doc_dir = doc_dir ++ "index.html" + type odoc = + { odoc_input: Path.t + ; html_dir: Path.t + ; html_file: Path.t + ; html_alias: Build_system.Alias.t + ; typ: [`Module | `Mld] + } -let setup_library_rules sctx (lib : Library.t) ~dir ~scope ~modules ~mld_files - ~requires ~(dep_graphs:Ocamldep.Dep_graph.t Ml_kind.Dict.t) = - let doc_dir = Doc.dir sctx lib in - let obj_dir, lib_unique_name = + let odoc_include_flags libs = + let paths = + libs |> List.fold_left ~f:(fun paths lib -> + if Lib.is_local lib then ( + Path.Set.add paths (Paths.odocs (Lib lib)) + ) else ( + paths + ) + ) ~init:Path.Set.empty in + 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 = + let to_remove, jbuilder_keep = + match odoc_file.typ 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] + in + SC.add_rule sctx + (deps + >>> Build.progn ( + Build.remove_tree to_remove + :: Build.mkdir odoc_file.html_dir + :: Build.run ~context ~dir:Paths.html_root + odoc ~extra_targets:[odoc_file.html_file] + [ A "html" + ; Dyn odoc_include_flags + ; A "-o"; Path Paths.html_root + ; Dep odoc_file.odoc_input + ] + :: jbuilder_keep + ) + ); + odoc_file.html_file + + let css_file = Paths.html_root ++ "odoc.css" + + let toplevel_index = Paths.html_root ++ "index.html" + + let setup_library_odoc_rules (library : Library.t) ~dir ~scope ~modules + ~requires ~(dep_graphs:Ocamldep.Dep_graph.t Ml_kind.Dict.t) = let lib = - Option.value_exn (Lib.DB.find_even_when_hidden (Scope.libs scope) lib.name) + Option.value_exn (Lib.DB.find_even_when_hidden (Scope.libs scope) + library.name) in + (* Using the proper package name doesn't actually work since odoc assumes + that a package contains only 1 library *) + let pkg_or_lnu = pkg_or_lnu lib in + let doc_dir = Paths.odocs (Lib lib) in + let obj_dir = Lib.obj_dir lib in + let includes = + Build.memoize "includes" + (requires + >>> Dep.deps + >>^ Lib.L.include_flags ~stdlib_dir:context.stdlib_dir) in - let name = - let name = Lib.name lib in - match Lib.status lib with - | Installed -> assert false - | Public _ -> name - | Private scope_name -> - sprintf "%s@%s" name (Scope_info.Name.to_string scope_name) + let modules_and_odoc_files = + List.map (Module.Name.Map.values modules) ~f:( + compile_module ~dir ~obj_dir ~includes ~dep_graphs + ~doc_dir ~pkg_or_lnu) in - (Lib.obj_dir lib, name) - in - let odoc = get_odoc sctx in - let includes = - let ctx = SC.context sctx in - Build.memoize "includes" - (requires - >>> Doc.deps sctx - >>^ Lib.L.include_flags ~stdlib_dir:ctx.stdlib_dir) - in - let mld_files = - all_mld_files sctx ~dir ~lib ~modules mld_files - in - let mld_and_odoc_files = - List.map mld_files ~f:(fun m -> - compile sctx ~odoc ~dir ~obj_dir ~includes ~dep_graphs - ~doc_dir ~lib_unique_name (Mld m)) - in - let modules_and_odoc_files = - List.map (Module.Name.Map.values modules) ~f:(fun m -> - compile sctx ~odoc ~dir ~obj_dir ~includes ~dep_graphs - ~doc_dir ~lib_unique_name (Module m)) - in - let inputs_and_odoc_files = modules_and_odoc_files @ mld_and_odoc_files in - Doc.setup_deps sctx lib (List.map inputs_and_odoc_files ~f:snd); - (* - let modules_and_odoc_files = - if lib.wrapped then - let main_module_name = String.capitalize lib.name in - List.filter modules_and_odoc_files - ~f:(fun (m, _) -> m.Module.name = main_module_name) - else - modules_and_odoc_files - in*) - let html_files = - List.map inputs_and_odoc_files ~f:(fun (m, odoc_file) -> - to_html sctx m odoc_file ~doc_dir ~odoc ~dir ~includes ~lib) - in - let doc_root = Doc.root sctx in - let alias = - match lib.public with - | None -> Build_system.Alias.private_doc ~dir - | Some _ -> Build_system.Alias.doc ~dir in - SC.add_alias_deps sctx alias - (css_file ~doc_dir:doc_root - :: toplevel_index ~doc_dir:doc_root - :: html_files) + Dep.setup_deps (Lib lib) (List.map modules_and_odoc_files ~f:snd) -let setup_css_rule sctx = - let context = SC.context sctx in - let doc_dir = Doc.root sctx in - SC.add_rule sctx - (Build.run ~context - ~dir:context.build_dir - ~extra_targets:[css_file ~doc_dir] - (get_odoc sctx) - [ A "css"; A "-o"; Path doc_dir ]) + let setup_css_rule () = + SC.add_rule sctx + (Build.run ~context + ~dir:context.build_dir + ~extra_targets:[css_file] + odoc + [ A "css"; A "-o"; Path Paths.html_root ]) -let sp = Printf.sprintf + let sp = Printf.sprintf -let setup_toplevel_index_rule sctx = - let list_items = - Super_context.stanzas_to_consider_for_install sctx - |> List.filter_map ~f:(fun (_path, _scope, stanza) -> - match stanza with - | Stanza.Library - {Library.kind = Library.Kind.Normal; public = Some public_info; _} -> - let name = public_info.name in + let setup_toplevel_index_rule () = + let list_items = + Super_context.packages sctx + |> Package.Name.Map.to_list + |> List.filter_map ~f:(fun (name, pkg) -> + let name = Package.Name.to_string name in let link = sp {|%s|} name name in let version_suffix = - match public_info.package.Package.version_from_opam_file with + match pkg.Package.version_from_opam_file with | None -> "" | Some v -> sp {| %s|} v in - Some (sp "