Install rules for mlds

This commit is contained in:
Rudi Grinberg 2018-03-16 13:24:28 +08:00
parent 25d52d1e3a
commit 86768475b2
4 changed files with 54 additions and 1 deletions

View File

@ -150,6 +150,25 @@ module Gen(P : Install_rules.Params) = struct
modules
end
let parse_mlds ~dir ~(all_mlds : string String_map.t) ~mlds_written_by_user =
if Ordered_set_lang.is_standard mlds_written_by_user then
all_mlds
else
let mlds =
Ordered_set_lang.String.eval_unordered
mlds_written_by_user
~parse:(fun ~loc s ->
match String_map.find all_mlds s with
| Some s ->
s
| None ->
Loc.fail loc "%s.mld doesn't exist in %s" s
(Path.to_string_maybe_quoted
(Path.drop_optional_build_context dir))
)
~standard:all_mlds in
mlds
(* +-----------------------------------------------------------------+
| User rules & copy files |
+-----------------------------------------------------------------+ *)
@ -292,6 +311,28 @@ module Gen(P : Install_rules.Params) = struct
}
)
let guess_mlds ~files =
String_set.to_list files
|> List.filter_map ~f:(fun fn ->
match String.lsplit2 fn ~on:'.' with
| Some (s, "mld") -> Some (s, fn)
| _ -> None)
|> String_map.of_list_exn
let mlds_by_dir =
let cache = Hashtbl.create 32 in
fun ~dir ->
Hashtbl.find_or_add cache dir ~f:(fun dir ->
let files = text_files ~dir in
guess_mlds ~files)
let mlds_of_dir (doc : Documentation.t) ~dir =
parse_mlds ~dir
~all_mlds:(mlds_by_dir ~dir)
~mlds_written_by_user:doc.mld_files
|> String_map.values
|> List.map ~f:(Path.relative dir)
let modules_by_dir =
let cache = Hashtbl.create 32 in
fun ~dir ->
@ -963,6 +1004,7 @@ module Gen(P : Install_rules.Params) = struct
Install_rules.Gen(struct
include P
let module_names_of_lib = module_names_of_lib
let mlds_of_dir = mlds_of_dir
end) in
Install_rules.init ()
end
@ -1010,7 +1052,8 @@ let gen ~contexts ~build_system
match (stanza : Stanza.t) with
| Library { public = Some { package; _ }; _ }
| Alias { package = Some package ; _ }
| Install { package; _ } ->
| Install { package; _ }
| Documentation { package; _ } ->
Package.Name.Set.mem pkgs package.name
| _ -> true)))
in

View File

@ -10,6 +10,7 @@ end
module type Install_params = sig
include Params
val module_names_of_lib : Library.t -> dir:Path.t -> Module.t list
val mlds_of_dir : Documentation.t -> dir:Path.t -> Path.t list
end
module Archives(P : Params) = struct
@ -269,6 +270,13 @@ module Gen(P : Install_params) = struct
List.map files ~f:(fun { Install_conf. src; dst } ->
(package.name,
Install.Entry.make section (Path.relative dir src) ?dst))
| Documentation ({ package; _ } as d) ->
List.map ~f:(fun mld ->
(package.name,
(Install.Entry.make
~dst:(sprintf "odoc-pages/%s" (Path.basename mld))
Install.Section.Doc mld))
) (mlds_of_dir d ~dir)
| _ -> [])
|> Package.Name.Map.of_list_multi
in

View File

@ -11,6 +11,7 @@ end
module type Install_params = sig
include Params
val module_names_of_lib : Jbuild.Library.t -> dir:Path.t -> Module.t list
val mlds_of_dir : Jbuild.Documentation.t -> dir:Path.t -> Path.t list
end
(** Generate install rules for META and .install files *)

View File

@ -114,6 +114,7 @@ let create
let keep =
match (stanza : Stanza.t) with
| Library lib -> Lib.DB.available (Scope.libs scope) lib.name
| Documentation _
| Install _ -> true
| _ -> false
in