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
199
src/gen_rules.ml
199
src/gen_rules.ml
|
@ -237,112 +237,115 @@ 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
|
||||||
match Path.Map.find stanzas_per_dir dir with
|
}
|
||||||
| None -> String.Set.empty
|
|
||||||
| Some { stanzas; src_dir; scope; _ } ->
|
|
||||||
(* Interpret a few stanzas in order to determine the list of
|
|
||||||
files generated by the user. *)
|
|
||||||
let generated_files =
|
|
||||||
List.concat_map stanzas ~f:(fun stanza ->
|
|
||||||
match (stanza : Stanza.t) with
|
|
||||||
| Menhir.T menhir ->
|
|
||||||
Menhir_rules.targets menhir
|
|
||||||
| Rule rule ->
|
|
||||||
List.map (user_rule rule ~dir ~scope) ~f:Path.basename
|
|
||||||
| Copy_files def ->
|
|
||||||
List.map (copy_files_rules def ~src_dir ~dir ~scope)
|
|
||||||
~f:Path.basename
|
|
||||||
| Library { buildable; _ } | Executables { buildable; _ } ->
|
|
||||||
(* Manually add files generated by the (select ...)
|
|
||||||
dependencies *)
|
|
||||||
List.filter_map buildable.libraries ~f:(fun dep ->
|
|
||||||
match (dep : Jbuild.Lib_dep.t) with
|
|
||||||
| Direct _ -> None
|
|
||||||
| Select s -> Some s.result_fn)
|
|
||||||
| _ -> [])
|
|
||||||
|> String.Set.of_list
|
|
||||||
in
|
|
||||||
String.Set.union generated_files
|
|
||||||
(SC.source_files sctx ~src_path:src_dir))
|
|
||||||
|
|
||||||
(* +-----------------------------------------------------------------+
|
val get : dir:Path.t -> t
|
||||||
| Modules listing |
|
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
|
||||||
|
}
|
||||||
|
|
||||||
let guess_modules ~dir ~files =
|
(* As a side-effect, setup user rules and copy_files rules. *)
|
||||||
let make_module syntax base fn =
|
let load_text_files ~dir =
|
||||||
(Module.Name.of_string base,
|
match Path.Map.find stanzas_per_dir dir with
|
||||||
Module.File.make syntax (Path.relative dir fn))
|
| None -> String.Set.empty
|
||||||
in
|
| Some { stanzas; src_dir; scope; _ } ->
|
||||||
let impl_files, intf_files =
|
(* Interpret a few stanzas in order to determine the list of
|
||||||
String.Set.to_list files
|
files generated by the user. *)
|
||||||
|> List.filter_partition_map ~f:(fun fn ->
|
let generated_files =
|
||||||
(* we aren't using Filename.extension because we want to handle
|
List.concat_map stanzas ~f:(fun stanza ->
|
||||||
filenames such as foo.cppo.ml *)
|
match (stanza : Stanza.t) with
|
||||||
|
| Menhir.T menhir ->
|
||||||
|
Menhir_rules.targets menhir
|
||||||
|
| Rule rule ->
|
||||||
|
List.map (user_rule rule ~dir ~scope) ~f:Path.basename
|
||||||
|
| Copy_files def ->
|
||||||
|
List.map (copy_files_rules def ~src_dir ~dir ~scope)
|
||||||
|
~f:Path.basename
|
||||||
|
| Library { buildable; _ } | Executables { buildable; _ } ->
|
||||||
|
(* Manually add files generated by the (select ...)
|
||||||
|
dependencies *)
|
||||||
|
List.filter_map buildable.libraries ~f:(fun dep ->
|
||||||
|
match (dep : Jbuild.Lib_dep.t) with
|
||||||
|
| Direct _ -> None
|
||||||
|
| Select s -> Some s.result_fn)
|
||||||
|
| _ -> [])
|
||||||
|
|> String.Set.of_list
|
||||||
|
in
|
||||||
|
String.Set.union generated_files
|
||||||
|
(SC.source_files sctx ~src_path:src_dir)
|
||||||
|
|
||||||
|
let extract_modules ~dir ~files =
|
||||||
|
let make_module syntax base fn =
|
||||||
|
(Module.Name.of_string base,
|
||||||
|
Module.File.make syntax (Path.relative dir fn))
|
||||||
|
in
|
||||||
|
let impl_files, intf_files =
|
||||||
|
String.Set.to_list files
|
||||||
|
|> List.filter_partition_map ~f:(fun fn ->
|
||||||
|
(* we aren't using Filename.extension because we want to handle
|
||||||
|
filenames such as foo.cppo.ml *)
|
||||||
|
match String.lsplit2 fn ~on:'.' with
|
||||||
|
| Some (s, "ml" ) -> Left (make_module OCaml s fn)
|
||||||
|
| Some (s, "re" ) -> Left (make_module Reason s fn)
|
||||||
|
| Some (s, "mli") -> Right (make_module OCaml s fn)
|
||||||
|
| Some (s, "rei") -> Right (make_module Reason s fn)
|
||||||
|
| _ -> Skip)
|
||||||
|
in
|
||||||
|
let parse_one_set (files : (Module.Name.t * Module.File.t) list) =
|
||||||
|
match Module.Name.Map.of_list files with
|
||||||
|
| Ok x -> x
|
||||||
|
| Error (name, f1, f2) ->
|
||||||
|
let src_dir = Path.drop_build_context_exn dir in
|
||||||
|
die "Too many files for module %a in %a:\
|
||||||
|
\n- %a\
|
||||||
|
\n- %a"
|
||||||
|
Module.Name.pp name
|
||||||
|
Path.pp src_dir
|
||||||
|
Path.pp f1.path
|
||||||
|
Path.pp f2.path
|
||||||
|
in
|
||||||
|
let impls = parse_one_set impl_files in
|
||||||
|
let intfs = parse_one_set intf_files in
|
||||||
|
Module.Name.Map.merge impls intfs ~f:(fun name impl intf ->
|
||||||
|
Some (Module.make name ?impl ?intf))
|
||||||
|
|
||||||
|
let extract_mlds ~files =
|
||||||
|
String.Set.fold files ~init:String.Map.empty ~f:(fun fn acc ->
|
||||||
match String.lsplit2 fn ~on:'.' with
|
match String.lsplit2 fn ~on:'.' with
|
||||||
| Some (s, "ml" ) -> Left (make_module OCaml s fn)
|
| Some (s, "mld") -> String.Map.add acc s fn
|
||||||
| Some (s, "re" ) -> Left (make_module Reason s fn)
|
| _ -> acc)
|
||||||
| Some (s, "mli") -> Right (make_module OCaml s fn)
|
|
||||||
| Some (s, "rei") -> Right (make_module Reason s fn)
|
|
||||||
| _ -> Skip)
|
|
||||||
in
|
|
||||||
let parse_one_set (files : (Module.Name.t * Module.File.t) list) =
|
|
||||||
match Module.Name.Map.of_list files with
|
|
||||||
| Ok x -> x
|
|
||||||
| Error (name, f1, f2) ->
|
|
||||||
let src_dir = Path.drop_build_context_exn dir in
|
|
||||||
die "Too many files for module %a in %a:\
|
|
||||||
\n- %a\
|
|
||||||
\n- %a"
|
|
||||||
Module.Name.pp name
|
|
||||||
Path.pp src_dir
|
|
||||||
Path.pp f1.path
|
|
||||||
Path.pp f2.path
|
|
||||||
in
|
|
||||||
let impls = parse_one_set impl_files in
|
|
||||||
let intfs = parse_one_set intf_files in
|
|
||||||
Module.Name.Map.merge impls intfs ~f:(fun name impl intf ->
|
|
||||||
Some (Module.make name ?impl ?intf))
|
|
||||||
|
|
||||||
let guess_mlds ~files =
|
let get =
|
||||||
String.Set.to_list files
|
let cache = Hashtbl.create 32 in
|
||||||
|> List.filter_map ~f:(fun fn ->
|
fun ~dir ->
|
||||||
match String.lsplit2 fn ~on:'.' with
|
Hashtbl.find_or_add cache dir ~f:(fun dir ->
|
||||||
| Some (s, "mld") -> Some (s, fn)
|
let files = load_text_files ~dir in
|
||||||
| _ -> None)
|
{ text_files = files
|
||||||
|> String.Map.of_list_exn
|
; modules = lazy (extract_modules ~dir ~files)
|
||||||
|
; mlds = lazy (extract_mlds ~files)
|
||||||
let mlds_by_dir =
|
})
|
||||||
let cache = Hashtbl.create 32 in
|
end
|
||||||
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 =
|
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