2017-05-11 17:09:44 +00:00
|
|
|
open Import
|
2017-06-02 13:32:05 +00:00
|
|
|
open Jbuild
|
2017-05-11 17:09:44 +00:00
|
|
|
open Build.O
|
|
|
|
|
|
|
|
module SC = Super_context
|
|
|
|
|
2018-02-28 10:24:37 +00:00
|
|
|
module Doc = struct
|
|
|
|
let root sctx = Path.relative (SC.context sctx).Context.build_dir "_doc"
|
|
|
|
|
|
|
|
type origin =
|
|
|
|
| Public of string
|
|
|
|
| Private of string * Scope_info.Name.t
|
|
|
|
|
|
|
|
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 dir t (lib : Library.t) =
|
|
|
|
dir_internal t
|
|
|
|
(match lib.public with
|
|
|
|
| Some { name; _ } -> Public name
|
|
|
|
| None -> Private (lib.name, lib.scope_name))
|
|
|
|
|
|
|
|
let alias = Build_system.Alias.make ".doc-all"
|
|
|
|
|
|
|
|
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 alias t lib = alias ~dir:(dir t lib)
|
|
|
|
|
|
|
|
let static_deps t lib = Build_system.Alias.dep (alias t lib)
|
|
|
|
|
|
|
|
let setup_deps t lib files = SC.add_alias_deps t (alias t lib) files
|
|
|
|
|
|
|
|
let dir t lib = dir t lib
|
|
|
|
end
|
|
|
|
|
|
|
|
|
2017-05-11 17:09:44 +00:00
|
|
|
let ( ++ ) = Path.relative
|
|
|
|
|
|
|
|
let get_odoc sctx = SC.resolve_program sctx "odoc" ~hint:"opam install odoc"
|
2017-05-22 13:12:02 +00:00
|
|
|
let odoc_ext = ".odoc"
|
2017-05-11 17:09:44 +00:00
|
|
|
|
2018-01-13 12:51:28 +00:00
|
|
|
module Mld : sig
|
|
|
|
type t
|
|
|
|
val create : name:string -> t
|
2018-01-13 12:46:47 +00:00
|
|
|
|
2018-01-13 12:51:28 +00:00
|
|
|
val odoc_file : doc_dir:Path.t -> t -> Path.t
|
|
|
|
val odoc_input : doc_dir:Path.t -> t -> Path.t
|
2018-01-13 12:46:47 +00:00
|
|
|
|
2018-01-13 12:51:28 +00:00
|
|
|
val html_filename : t -> string
|
|
|
|
end = struct
|
|
|
|
type t = string (** source file name without the extension. *)
|
|
|
|
|
|
|
|
let create ~name = name
|
|
|
|
|
|
|
|
let odoc_file ~doc_dir t =
|
|
|
|
Path.relative doc_dir (sprintf "page-%s%s" t odoc_ext)
|
|
|
|
|
|
|
|
let odoc_input ~doc_dir t =
|
|
|
|
Path.relative doc_dir (sprintf "%s-generated.mld" t)
|
|
|
|
|
|
|
|
let html_filename t =
|
|
|
|
sprintf "%s.html" t
|
2018-01-13 12:46:47 +00:00
|
|
|
end
|
|
|
|
|
|
|
|
module Module_or_mld = struct
|
|
|
|
type t =
|
|
|
|
| Mld of Mld.t
|
|
|
|
| Module of Module.t
|
|
|
|
|
2018-01-13 12:51:28 +00:00
|
|
|
let odoc_file ~doc_dir = function
|
|
|
|
| Mld m -> Mld.odoc_file ~doc_dir m
|
|
|
|
| Module m -> Module.odoc_file ~doc_dir m
|
2018-01-13 12:46:47 +00:00
|
|
|
|
2018-01-21 21:36:30 +00:00
|
|
|
let odoc_input ~obj_dir ~doc_dir = function
|
2018-01-13 12:51:28 +00:00
|
|
|
| Mld m -> Mld.odoc_input ~doc_dir m
|
2018-01-21 21:36:30 +00:00
|
|
|
| Module m -> Module.cmti_file m ~obj_dir
|
2018-01-13 12:51:28 +00:00
|
|
|
|
|
|
|
let html_dir ~doc_dir = function
|
|
|
|
| Mld _ -> doc_dir
|
2018-02-25 16:35:25 +00:00
|
|
|
| Module m -> doc_dir ++ String.capitalize m.obj_name
|
2018-01-13 12:51:28 +00:00
|
|
|
|
|
|
|
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"
|
2018-01-13 12:46:47 +00:00
|
|
|
end
|
|
|
|
|
2018-02-06 11:48:04 +00:00
|
|
|
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 ->
|
|
|
|
Build.dyn_paths
|
|
|
|
((match m.intf with
|
|
|
|
| Some _ ->
|
|
|
|
Ocamldep.Dep_graph.deps_of dep_graphs.intf m
|
|
|
|
| None ->
|
|
|
|
(* When a module has no .mli, use the dependencies for the .ml *)
|
|
|
|
Ocamldep.Dep_graph.deps_of dep_graphs.impl m)
|
|
|
|
>>^ List.map ~f:(Module.odoc_file ~doc_dir))
|
|
|
|
|
2018-01-21 21:36:30 +00:00
|
|
|
let compile sctx (m : Module_or_mld.t) ~odoc ~dir ~obj_dir ~includes ~dep_graphs
|
2018-02-06 11:48:04 +00:00
|
|
|
~doc_dir ~lib_unique_name =
|
2017-05-11 17:09:44 +00:00
|
|
|
let context = SC.context sctx in
|
2018-01-13 12:51:28 +00:00
|
|
|
let odoc_file = Module_or_mld.odoc_file m ~doc_dir in
|
2017-05-11 17:09:44 +00:00
|
|
|
SC.add_rule sctx
|
2018-02-06 11:48:04 +00:00
|
|
|
(module_or_mld_deps m ~doc_dir ~dep_graphs
|
2017-05-11 17:09:44 +00:00
|
|
|
>>>
|
|
|
|
includes
|
|
|
|
>>>
|
2018-01-13 12:51:28 +00:00
|
|
|
Build.run ~context ~dir:doc_dir odoc
|
2017-05-11 17:09:44 +00:00
|
|
|
[ A "compile"
|
2017-10-24 11:58:34 +00:00
|
|
|
; A "-I"; Path dir
|
2018-01-13 12:46:47 +00:00
|
|
|
; Dyn (fun x -> x)
|
2017-12-17 14:56:05 +00:00
|
|
|
; As ["--pkg"; lib_unique_name]
|
2018-01-13 12:51:28 +00:00
|
|
|
; A "-o"; Target odoc_file
|
2018-01-21 21:36:30 +00:00
|
|
|
; Dep (Module_or_mld.odoc_input m ~obj_dir ~doc_dir)
|
2017-05-11 17:09:44 +00:00
|
|
|
]);
|
|
|
|
(m, odoc_file)
|
|
|
|
|
2018-01-13 12:46:47 +00:00
|
|
|
let to_html sctx (m : Module_or_mld.t) odoc_file ~doc_dir ~odoc ~dir ~includes
|
2018-01-13 12:51:28 +00:00
|
|
|
~(lib : Library.t) =
|
2017-05-11 17:09:44 +00:00
|
|
|
let context = SC.context sctx in
|
2018-01-13 12:51:28 +00:00
|
|
|
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 =
|
2018-01-13 12:46:47 +00:00
|
|
|
match m with
|
2018-01-13 12:51:28 +00:00
|
|
|
| Mld _ -> html_file, []
|
|
|
|
| Module _ ->
|
2018-01-13 12:46:47 +00:00
|
|
|
let jbuilder_keep =
|
2018-01-13 12:51:28 +00:00
|
|
|
Build.create_file (html_dir ++ Config.jbuilder_keep_fname) in
|
|
|
|
html_dir, [jbuilder_keep]
|
2018-01-13 12:46:47 +00:00
|
|
|
in
|
2017-05-11 17:09:44 +00:00
|
|
|
SC.add_rule sctx
|
2018-02-28 10:24:37 +00:00
|
|
|
(Doc.static_deps sctx lib
|
2017-05-11 17:09:44 +00:00
|
|
|
>>>
|
|
|
|
includes
|
|
|
|
>>>
|
2018-01-13 12:46:47 +00:00
|
|
|
Build.progn (
|
|
|
|
Build.remove_tree to_remove
|
|
|
|
:: Build.mkdir html_dir
|
|
|
|
:: Build.run ~context ~dir odoc ~extra_targets:[html_file]
|
|
|
|
[ A "html"
|
2018-01-13 12:51:28 +00:00
|
|
|
; A "-I"; Path doc_dir
|
2018-01-13 12:46:47 +00:00
|
|
|
; Dyn (fun x -> x)
|
2018-01-13 12:51:28 +00:00
|
|
|
; A "-o"; Path (Path.parent doc_dir)
|
2018-01-13 12:46:47 +00:00
|
|
|
; Dep odoc_file
|
|
|
|
]
|
|
|
|
:: jbuilder_keep
|
|
|
|
)
|
2017-05-25 15:57:29 +00:00
|
|
|
);
|
2017-05-11 17:09:44 +00:00
|
|
|
html_file
|
|
|
|
|
2018-02-26 07:55:40 +00:00
|
|
|
let all_mld_files sctx ~(lib : Library.t) ~modules ~dir files =
|
2018-01-13 12:46:47 +00:00
|
|
|
let all_files =
|
|
|
|
if List.mem "index.mld" ~set:files then files else "index.mld" :: files
|
2017-05-12 14:05:16 +00:00
|
|
|
in
|
2018-02-26 07:55:40 +00:00
|
|
|
let lib_name = Library.best_name lib in
|
2018-02-28 10:24:37 +00:00
|
|
|
let doc_dir = Doc.dir sctx lib in
|
2018-01-13 12:46:47 +00:00
|
|
|
List.map all_files ~f:(fun file ->
|
|
|
|
let name = Filename.chop_extension file in
|
2018-01-13 12:51:28 +00:00
|
|
|
let mld = Mld.create ~name in
|
|
|
|
let generated_mld = Mld.odoc_input ~doc_dir mld in
|
2018-01-13 12:46:47 +00:00
|
|
|
let source_mld = dir ++ file 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
|
2018-02-25 16:35:25 +00:00
|
|
|
(String.capitalize lib.name)
|
2018-01-13 12:46:47 +00:00
|
|
|
else
|
|
|
|
sprintf
|
|
|
|
"{1 Library %s}\n\
|
|
|
|
This library exposes the following toplevel modules: {!modules:%s}."
|
|
|
|
lib_name
|
|
|
|
(String_map.keys modules |> String.concat ~sep:" "))))
|
|
|
|
>>>
|
|
|
|
Build.write_file_dyn generated_mld);
|
2018-01-13 12:51:28 +00:00
|
|
|
mld
|
2018-01-13 12:46:47 +00:00
|
|
|
)
|
2017-05-12 14:05:16 +00:00
|
|
|
|
2017-05-22 13:12:02 +00:00
|
|
|
let css_file ~doc_dir = doc_dir ++ "odoc.css"
|
2017-05-11 17:09:44 +00:00
|
|
|
|
2017-08-21 15:16:14 +00:00
|
|
|
let toplevel_index ~doc_dir = doc_dir ++ "index.html"
|
|
|
|
|
2018-02-20 11:46:10 +00:00
|
|
|
let setup_library_rules sctx (lib : Library.t) ~dir ~scope ~modules ~mld_files
|
2018-02-06 11:48:04 +00:00
|
|
|
~requires ~(dep_graphs:Ocamldep.Dep_graph.t Ml_kind.Dict.t) =
|
2018-02-28 10:24:37 +00:00
|
|
|
let doc_dir = Doc.dir sctx lib in
|
2018-02-20 11:46:10 +00:00
|
|
|
let obj_dir, lib_unique_name =
|
2018-02-28 18:50:48 +00:00
|
|
|
let lib =
|
|
|
|
Option.value_exn (Lib.DB.find_even_when_hidden (Scope.libs scope) lib.name)
|
2018-02-20 11:46:10 +00:00
|
|
|
in
|
|
|
|
let name =
|
2018-02-28 18:50:48 +00:00
|
|
|
let name = Lib.name lib in
|
|
|
|
match Lib.status lib with
|
2018-02-20 11:46:10 +00:00
|
|
|
| Installed -> assert false
|
|
|
|
| Public -> name
|
|
|
|
| Private scope_name ->
|
|
|
|
sprintf "%s@%s" name (Scope_info.Name.to_string scope_name)
|
|
|
|
in
|
2018-02-28 18:50:48 +00:00
|
|
|
(Lib.obj_dir lib, name)
|
2018-02-20 11:46:10 +00:00
|
|
|
in
|
2017-11-03 15:12:06 +00:00
|
|
|
let odoc = get_odoc sctx in
|
|
|
|
let includes =
|
2018-02-06 11:49:44 +00:00
|
|
|
let ctx = SC.context sctx in
|
2017-11-03 15:12:06 +00:00
|
|
|
Build.memoize "includes"
|
|
|
|
(requires
|
2018-02-28 10:24:37 +00:00
|
|
|
>>> Doc.deps sctx
|
2018-02-20 11:46:10 +00:00
|
|
|
>>^ Lib.L.include_flags ~stdlib_dir:ctx.stdlib_dir)
|
2017-11-03 15:12:06 +00:00
|
|
|
in
|
2018-01-13 12:46:47 +00:00
|
|
|
let mld_files =
|
2018-02-26 07:55:40 +00:00
|
|
|
all_mld_files sctx ~dir ~lib ~modules mld_files
|
2018-01-13 12:46:47 +00:00
|
|
|
in
|
|
|
|
let mld_and_odoc_files =
|
|
|
|
List.map mld_files ~f:(fun m ->
|
2018-01-21 21:36:30 +00:00
|
|
|
compile sctx ~odoc ~dir ~obj_dir ~includes ~dep_graphs
|
2018-01-13 12:51:28 +00:00
|
|
|
~doc_dir ~lib_unique_name (Mld m))
|
2018-01-13 12:46:47 +00:00
|
|
|
in
|
2017-11-03 15:12:06 +00:00
|
|
|
let modules_and_odoc_files =
|
2018-01-13 12:46:47 +00:00
|
|
|
List.map (String_map.values modules) ~f:(fun m ->
|
2018-01-21 21:36:30 +00:00
|
|
|
compile sctx ~odoc ~dir ~obj_dir ~includes ~dep_graphs
|
2018-01-13 12:51:28 +00:00
|
|
|
~doc_dir ~lib_unique_name (Module m))
|
2017-11-03 15:12:06 +00:00
|
|
|
in
|
2018-01-13 12:46:47 +00:00
|
|
|
let inputs_and_odoc_files = modules_and_odoc_files @ mld_and_odoc_files in
|
2018-02-28 10:24:37 +00:00
|
|
|
Doc.setup_deps sctx lib (List.map inputs_and_odoc_files ~f:snd);
|
2018-01-13 12:46:47 +00:00
|
|
|
(*
|
2018-02-20 11:46:10 +00:00
|
|
|
let modules_and_odoc_files =
|
|
|
|
if lib.wrapped then
|
2018-02-25 16:35:25 +00:00
|
|
|
let main_module_name = String.capitalize lib.name in
|
2018-02-20 11:46:10 +00:00
|
|
|
List.filter modules_and_odoc_files
|
|
|
|
~f:(fun (m, _) -> m.Module.name = main_module_name)
|
|
|
|
else
|
|
|
|
modules_and_odoc_files
|
|
|
|
in*)
|
2017-11-03 15:12:06 +00:00
|
|
|
let html_files =
|
2018-01-13 12:46:47 +00:00
|
|
|
List.map inputs_and_odoc_files ~f:(fun (m, odoc_file) ->
|
2018-01-13 12:51:28 +00:00
|
|
|
to_html sctx m odoc_file ~doc_dir ~odoc ~dir ~includes ~lib)
|
2017-11-03 15:12:06 +00:00
|
|
|
in
|
2018-02-28 10:24:37 +00:00
|
|
|
let doc_root = Doc.root sctx in
|
2018-02-16 09:22:28 +00:00
|
|
|
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
|
2018-01-13 12:51:28 +00:00
|
|
|
(css_file ~doc_dir:doc_root
|
|
|
|
:: toplevel_index ~doc_dir:doc_root
|
2017-11-03 15:12:06 +00:00
|
|
|
:: html_files)
|
2017-05-11 17:09:44 +00:00
|
|
|
|
|
|
|
let setup_css_rule sctx =
|
|
|
|
let context = SC.context sctx in
|
2018-02-28 10:24:37 +00:00
|
|
|
let doc_dir = Doc.root sctx in
|
2017-05-11 17:09:44 +00:00
|
|
|
SC.add_rule sctx
|
|
|
|
(Build.run ~context
|
|
|
|
~dir:context.build_dir
|
2017-05-22 13:12:02 +00:00
|
|
|
~extra_targets:[css_file ~doc_dir]
|
2017-05-11 17:09:44 +00:00
|
|
|
(get_odoc sctx)
|
2017-08-21 15:16:14 +00:00
|
|
|
[ A "css"; A "-o"; Path doc_dir ])
|
|
|
|
|
|
|
|
let sp = Printf.sprintf
|
|
|
|
|
|
|
|
let setup_toplevel_index_rule sctx =
|
2017-10-11 14:39:46 +00:00
|
|
|
let list_items =
|
|
|
|
Super_context.stanzas_to_consider_for_install sctx
|
2018-02-20 11:46:10 +00:00
|
|
|
|> List.filter_map ~f:(fun (_path, _scope, stanza) ->
|
2017-10-11 14:39:46 +00:00
|
|
|
match stanza with
|
|
|
|
| Stanza.Library
|
|
|
|
{Library.kind = Library.Kind.Normal; public = Some public_info; _} ->
|
|
|
|
let name = public_info.name in
|
|
|
|
let link = sp {|<a href="%s/index.html">%s</a>|} name name in
|
|
|
|
let version_suffix =
|
|
|
|
match public_info.package.Package.version_from_opam_file with
|
|
|
|
| None ->
|
|
|
|
""
|
|
|
|
| Some v ->
|
|
|
|
sp {| <span class="version">%s</span>|} v
|
|
|
|
in
|
|
|
|
Some (sp "<li>%s%s</li>" link version_suffix)
|
|
|
|
|
|
|
|
| _ ->
|
|
|
|
None)
|
2017-08-21 15:16:14 +00:00
|
|
|
in
|
2017-10-11 14:39:46 +00:00
|
|
|
let list_items = String.concat ~sep:"\n " list_items in
|
2017-08-21 15:16:14 +00:00
|
|
|
let html =
|
|
|
|
sp {|<!DOCTYPE html>
|
|
|
|
<html xmlns="http://www.w3.org/1999/xhtml">
|
|
|
|
<head>
|
|
|
|
<title>index</title>
|
|
|
|
<link rel="stylesheet" href="./odoc.css"/>
|
|
|
|
<meta charset="utf-8"/>
|
|
|
|
<meta name="viewport" content="width=device-width,initial-scale=1.0"/>
|
|
|
|
</head>
|
|
|
|
<body>
|
|
|
|
<div class="by-name">
|
|
|
|
<h2>OCaml package documentation</h2>
|
|
|
|
<ol>
|
|
|
|
%s
|
|
|
|
</ol>
|
|
|
|
</body>
|
|
|
|
</html>
|
2017-10-11 14:39:46 +00:00
|
|
|
|} list_items
|
2017-08-21 15:16:14 +00:00
|
|
|
in
|
2018-02-28 10:24:37 +00:00
|
|
|
let doc_dir = Doc.root sctx in
|
2017-08-21 15:16:14 +00:00
|
|
|
SC.add_rule sctx @@ Build.write_file (toplevel_index ~doc_dir) html
|
2018-01-19 08:50:06 +00:00
|
|
|
|
2018-01-30 19:42:31 +00:00
|
|
|
let gen_rules sctx ~dir:_ rest =
|
2018-01-19 08:50:06 +00:00
|
|
|
match rest with
|
|
|
|
| [] ->
|
|
|
|
setup_css_rule sctx;
|
|
|
|
setup_toplevel_index_rule sctx
|
|
|
|
| lib :: _ ->
|
2018-02-20 11:46:10 +00:00
|
|
|
let lib, lib_db =
|
2018-01-30 19:42:31 +00:00
|
|
|
match String.rsplit2 lib ~on:'@' with
|
2018-02-16 09:22:28 +00:00
|
|
|
| None ->
|
2018-02-20 11:46:10 +00:00
|
|
|
(lib, SC.public_libs sctx)
|
2018-02-16 09:22:28 +00:00
|
|
|
| Some (lib, name) ->
|
2018-02-20 11:46:10 +00:00
|
|
|
(lib,
|
|
|
|
Scope.libs
|
|
|
|
(SC.find_scope_by_name sctx (Scope_info.Name.of_string name)))
|
2018-01-30 19:42:31 +00:00
|
|
|
in
|
2018-02-20 11:46:10 +00:00
|
|
|
match Lib.DB.find lib_db lib with
|
|
|
|
| Error _ -> ()
|
|
|
|
| Ok lib -> SC.load_dir sctx ~dir:(Lib.src_dir lib)
|