Install rules for mlds
This commit is contained in:
parent
25d52d1e3a
commit
86768475b2
|
@ -150,6 +150,25 @@ module Gen(P : Install_rules.Params) = struct
|
||||||
modules
|
modules
|
||||||
end
|
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 |
|
| 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 modules_by_dir =
|
||||||
let cache = Hashtbl.create 32 in
|
let cache = Hashtbl.create 32 in
|
||||||
fun ~dir ->
|
fun ~dir ->
|
||||||
|
@ -963,6 +1004,7 @@ module Gen(P : Install_rules.Params) = struct
|
||||||
Install_rules.Gen(struct
|
Install_rules.Gen(struct
|
||||||
include P
|
include P
|
||||||
let module_names_of_lib = module_names_of_lib
|
let module_names_of_lib = module_names_of_lib
|
||||||
|
let mlds_of_dir = mlds_of_dir
|
||||||
end) in
|
end) in
|
||||||
Install_rules.init ()
|
Install_rules.init ()
|
||||||
end
|
end
|
||||||
|
@ -1010,7 +1052,8 @@ let gen ~contexts ~build_system
|
||||||
match (stanza : Stanza.t) with
|
match (stanza : Stanza.t) with
|
||||||
| Library { public = Some { package; _ }; _ }
|
| Library { public = Some { package; _ }; _ }
|
||||||
| Alias { package = Some package ; _ }
|
| Alias { package = Some package ; _ }
|
||||||
| Install { package; _ } ->
|
| Install { package; _ }
|
||||||
|
| Documentation { package; _ } ->
|
||||||
Package.Name.Set.mem pkgs package.name
|
Package.Name.Set.mem pkgs package.name
|
||||||
| _ -> true)))
|
| _ -> true)))
|
||||||
in
|
in
|
||||||
|
|
|
@ -10,6 +10,7 @@ end
|
||||||
module type Install_params = sig
|
module type Install_params = sig
|
||||||
include Params
|
include Params
|
||||||
val module_names_of_lib : Library.t -> dir:Path.t -> Module.t list
|
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
|
end
|
||||||
|
|
||||||
module Archives(P : Params) = struct
|
module Archives(P : Params) = struct
|
||||||
|
@ -269,6 +270,13 @@ module Gen(P : Install_params) = struct
|
||||||
List.map files ~f:(fun { Install_conf. src; dst } ->
|
List.map files ~f:(fun { Install_conf. src; dst } ->
|
||||||
(package.name,
|
(package.name,
|
||||||
Install.Entry.make section (Path.relative dir src) ?dst))
|
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
|
|> Package.Name.Map.of_list_multi
|
||||||
in
|
in
|
||||||
|
|
|
@ -11,6 +11,7 @@ end
|
||||||
module type Install_params = sig
|
module type Install_params = sig
|
||||||
include Params
|
include Params
|
||||||
val module_names_of_lib : Jbuild.Library.t -> dir:Path.t -> Module.t list
|
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
|
end
|
||||||
|
|
||||||
(** Generate install rules for META and .install files *)
|
(** Generate install rules for META and .install files *)
|
||||||
|
|
|
@ -114,6 +114,7 @@ let create
|
||||||
let keep =
|
let keep =
|
||||||
match (stanza : Stanza.t) with
|
match (stanza : Stanza.t) with
|
||||||
| Library lib -> Lib.DB.available (Scope.libs scope) lib.name
|
| Library lib -> Lib.DB.available (Scope.libs scope) lib.name
|
||||||
|
| Documentation _
|
||||||
| Install _ -> true
|
| Install _ -> true
|
||||||
| _ -> false
|
| _ -> false
|
||||||
in
|
in
|
||||||
|
|
Loading…
Reference in New Issue