Refactor a bit the functions computing directories contents
Signed-off-by: Jeremie Dimino <jeremie@dimino.org>
This commit is contained in:
parent
bff39c3426
commit
5974be475a
|
@ -237,16 +237,28 @@ module Gen(P : Install_rules.Params) = struct
|
||||||
file_dst)
|
file_dst)
|
||||||
|
|
||||||
(* +-----------------------------------------------------------------+
|
(* +-----------------------------------------------------------------+
|
||||||
| "text" file listing |
|
| Directory contents |
|
||||||
+-----------------------------------------------------------------+ *)
|
+-----------------------------------------------------------------+ *)
|
||||||
|
|
||||||
(* Compute the list of "text" files (.ml, .c, ...). This is the list
|
module Dir_contents : sig
|
||||||
of source files + user generated ones. As a side-effect, setup
|
type t =
|
||||||
user rules and copy_files rules. *)
|
{ (* Set of "text" files (.ml, .c, ...). This is
|
||||||
let text_files =
|
the set of source files + user generated ones. *)
|
||||||
let cache = Hashtbl.create 32 in
|
text_files : String.Set.t
|
||||||
fun ~dir ->
|
; modules : Module.t Module.Name.Map.t Lazy.t
|
||||||
Hashtbl.find_or_add cache dir ~f:(fun dir ->
|
; mlds : string String.Map.t Lazy.t
|
||||||
|
}
|
||||||
|
|
||||||
|
val get : dir:Path.t -> t
|
||||||
|
end = struct
|
||||||
|
type t =
|
||||||
|
{ text_files : String.Set.t
|
||||||
|
; modules : Module.t Module.Name.Map.t Lazy.t
|
||||||
|
; mlds : string String.Map.t Lazy.t
|
||||||
|
}
|
||||||
|
|
||||||
|
(* As a side-effect, setup user rules and copy_files rules. *)
|
||||||
|
let load_text_files ~dir =
|
||||||
match Path.Map.find stanzas_per_dir dir with
|
match Path.Map.find stanzas_per_dir dir with
|
||||||
| None -> String.Set.empty
|
| None -> String.Set.empty
|
||||||
| Some { stanzas; src_dir; scope; _ } ->
|
| Some { stanzas; src_dir; scope; _ } ->
|
||||||
|
@ -273,13 +285,9 @@ module Gen(P : Install_rules.Params) = struct
|
||||||
|> String.Set.of_list
|
|> String.Set.of_list
|
||||||
in
|
in
|
||||||
String.Set.union generated_files
|
String.Set.union generated_files
|
||||||
(SC.source_files sctx ~src_path:src_dir))
|
(SC.source_files sctx ~src_path:src_dir)
|
||||||
|
|
||||||
(* +-----------------------------------------------------------------+
|
let extract_modules ~dir ~files =
|
||||||
| Modules listing |
|
|
||||||
+-----------------------------------------------------------------+ *)
|
|
||||||
|
|
||||||
let guess_modules ~dir ~files =
|
|
||||||
let make_module syntax base fn =
|
let make_module syntax base fn =
|
||||||
(Module.Name.of_string base,
|
(Module.Name.of_string base,
|
||||||
Module.File.make syntax (Path.relative dir fn))
|
Module.File.make syntax (Path.relative dir fn))
|
||||||
|
@ -314,35 +322,30 @@ module Gen(P : Install_rules.Params) = struct
|
||||||
Module.Name.Map.merge impls intfs ~f:(fun name impl intf ->
|
Module.Name.Map.merge impls intfs ~f:(fun name impl intf ->
|
||||||
Some (Module.make name ?impl ?intf))
|
Some (Module.make name ?impl ?intf))
|
||||||
|
|
||||||
let guess_mlds ~files =
|
let extract_mlds ~files =
|
||||||
String.Set.to_list files
|
String.Set.fold files ~init:String.Map.empty ~f:(fun fn acc ->
|
||||||
|> List.filter_map ~f:(fun fn ->
|
|
||||||
match String.lsplit2 fn ~on:'.' with
|
match String.lsplit2 fn ~on:'.' with
|
||||||
| Some (s, "mld") -> Some (s, fn)
|
| Some (s, "mld") -> String.Map.add acc s fn
|
||||||
| _ -> None)
|
| _ -> acc)
|
||||||
|> String.Map.of_list_exn
|
|
||||||
|
|
||||||
let mlds_by_dir =
|
let get =
|
||||||
let cache = Hashtbl.create 32 in
|
let cache = Hashtbl.create 32 in
|
||||||
fun ~dir ->
|
fun ~dir ->
|
||||||
Hashtbl.find_or_add cache dir ~f:(fun dir ->
|
Hashtbl.find_or_add cache dir ~f:(fun dir ->
|
||||||
let files = text_files ~dir in
|
let files = load_text_files ~dir in
|
||||||
guess_mlds ~files)
|
{ text_files = files
|
||||||
|
; modules = lazy (extract_modules ~dir ~files)
|
||||||
|
; mlds = lazy (extract_mlds ~files)
|
||||||
|
})
|
||||||
|
end
|
||||||
|
|
||||||
let mlds_of_dir (doc : Documentation.t) ~dir =
|
let mlds_of_dir (doc : Documentation.t) ~dir =
|
||||||
parse_mlds ~dir
|
parse_mlds ~dir
|
||||||
~all_mlds:(mlds_by_dir ~dir)
|
~all_mlds:(Lazy.force (Dir_contents.get ~dir).mlds)
|
||||||
~mlds_written_by_user:doc.mld_files
|
~mlds_written_by_user:doc.mld_files
|
||||||
|> String.Map.values
|
|> String.Map.values
|
||||||
|> List.map ~f:(Path.relative dir)
|
|> List.map ~f:(Path.relative dir)
|
||||||
|
|
||||||
let modules_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_modules ~dir ~files)
|
|
||||||
|
|
||||||
type modules_by_lib =
|
type modules_by_lib =
|
||||||
{ modules : Module.t Module.Name.Map.t
|
{ modules : Module.t Module.Name.Map.t
|
||||||
; alias_module : Module.t option
|
; alias_module : Module.t option
|
||||||
|
@ -353,7 +356,7 @@ module Gen(P : Install_rules.Params) = struct
|
||||||
let cache = Hashtbl.create 32 in
|
let cache = Hashtbl.create 32 in
|
||||||
fun (lib : Library.t) ~dir ->
|
fun (lib : Library.t) ~dir ->
|
||||||
Hashtbl.find_or_add cache (dir, lib.name) ~f:(fun _ ->
|
Hashtbl.find_or_add cache (dir, lib.name) ~f:(fun _ ->
|
||||||
let all_modules = modules_by_dir ~dir in
|
let all_modules = Lazy.force (Dir_contents.get ~dir).modules in
|
||||||
let modules =
|
let modules =
|
||||||
parse_modules ~all_modules ~buildable:lib.buildable
|
parse_modules ~all_modules ~buildable:lib.buildable
|
||||||
in
|
in
|
||||||
|
@ -1026,8 +1029,12 @@ module Gen(P : Install_rules.Params) = struct
|
||||||
|
|
||||||
let gen_rules { SC.Dir_with_jbuild. src_dir; ctx_dir; stanzas; scope; kind } =
|
let gen_rules { SC.Dir_with_jbuild. src_dir; ctx_dir; stanzas; scope; kind } =
|
||||||
(* This interprets "rule" and "copy_files" stanzas. *)
|
(* This interprets "rule" and "copy_files" stanzas. *)
|
||||||
let files = text_files ~dir:ctx_dir in
|
let { Dir_contents.
|
||||||
let all_modules = modules_by_dir ~dir:ctx_dir in
|
text_files = files
|
||||||
|
; modules = lazy all_modules
|
||||||
|
; _
|
||||||
|
} = Dir_contents.get ~dir:ctx_dir
|
||||||
|
in
|
||||||
let modules_partitioner = Modules_partitioner.create ~dir_kind:kind in
|
let modules_partitioner = Modules_partitioner.create ~dir_kind:kind in
|
||||||
let merlins =
|
let merlins =
|
||||||
List.filter_map stanzas ~f:(fun stanza ->
|
List.filter_map stanzas ~f:(fun stanza ->
|
||||||
|
|
Loading…
Reference in New Issue