Add File_tree.Dir.dune_file (#749)
This commit is contained in:
parent
5112c23e3f
commit
5ac3acf195
|
@ -129,17 +129,15 @@ let rule_loc ~file_tree ~loc ~dir =
|
|||
| Some loc -> loc
|
||||
| None ->
|
||||
let dir = Path.drop_optional_build_context dir in
|
||||
let fname =
|
||||
if File_tree.file_exists file_tree dir "dune" then
|
||||
"dune"
|
||||
else if File_tree.file_exists file_tree dir "jbuild" then
|
||||
"jbuild"
|
||||
else
|
||||
"_unknown_"
|
||||
let file =
|
||||
match
|
||||
Option.bind (File_tree.find_dir file_tree dir)
|
||||
~f:File_tree.Dir.dune_file
|
||||
with
|
||||
| Some file -> file
|
||||
| None -> Path.relative dir "_unknown_"
|
||||
in
|
||||
Loc.in_file
|
||||
(Path.to_string
|
||||
(Path.drop_optional_build_context (Path.relative dir fname)))
|
||||
Loc.in_file (Path.to_string file)
|
||||
|
||||
module Internal_rule = struct
|
||||
module Id : sig
|
||||
|
|
|
@ -38,6 +38,15 @@ module Dir = struct
|
|||
let acc = f t acc in
|
||||
String.Map.fold (sub_dirs t) ~init:acc ~f:(fun t acc ->
|
||||
fold t ~traverse_ignored_dirs ~init:acc ~f)
|
||||
|
||||
let dune_file t =
|
||||
let (lazy { files; _ }) = t.contents in
|
||||
if String.Set.mem files "dune" then
|
||||
Some (Path.relative t.path "dune")
|
||||
else if String.Set.mem files "jbuild" then
|
||||
Some (Path.relative t.path "jbuild")
|
||||
else
|
||||
None
|
||||
end
|
||||
|
||||
type t =
|
||||
|
|
|
@ -22,6 +22,9 @@ module Dir : sig
|
|||
-> init:'a
|
||||
-> f:(t -> 'a -> 'a)
|
||||
-> 'a
|
||||
|
||||
(** Return the dune (or jbuild) file in this directory *)
|
||||
val dune_file : t -> Path.t option
|
||||
end
|
||||
|
||||
(** A [t] value represent a view of the source tree. It is lazily
|
||||
|
|
|
@ -207,8 +207,7 @@ module Sexp_io = struct
|
|||
loop0 Parser.Stack.empty 0)
|
||||
end
|
||||
|
||||
let load ~dir ~scope ~ignore_promoted_rules ~fname =
|
||||
let file = Path.relative dir fname in
|
||||
let load ~dir ~scope ~ignore_promoted_rules ~file =
|
||||
match Sexp_io.load_many_or_ocaml_script file with
|
||||
| Sexps sexps ->
|
||||
Jbuilds.Literal (dir, scope,
|
||||
|
@ -299,22 +298,16 @@ let load ?extra_ignored_subtrees ?(ignore_promoted_rules=false) () =
|
|||
jbuilds
|
||||
else begin
|
||||
let path = File_tree.Dir.path dir in
|
||||
let files = File_tree.Dir.files dir in
|
||||
let sub_dirs = File_tree.Dir.sub_dirs dir in
|
||||
let scope = Option.value (Path.Map.find scopes path) ~default:scope in
|
||||
let jbuilds =
|
||||
if String.Set.mem files "dune" then
|
||||
match File_tree.Dir.dune_file dir with
|
||||
| None -> jbuilds
|
||||
| Some file ->
|
||||
let jbuild =
|
||||
load ~dir:path ~scope ~ignore_promoted_rules ~fname:"dune"
|
||||
load ~dir:path ~scope ~ignore_promoted_rules ~file
|
||||
in
|
||||
jbuild :: jbuilds
|
||||
else if String.Set.mem files "jbuild" then
|
||||
let jbuild =
|
||||
load ~dir:path ~scope ~ignore_promoted_rules ~fname:"jbuild"
|
||||
in
|
||||
jbuild :: jbuilds
|
||||
else
|
||||
jbuilds
|
||||
in
|
||||
String.Map.fold sub_dirs ~init:jbuilds
|
||||
~f:(fun dir jbuilds -> walk dir jbuilds scope)
|
||||
|
|
Loading…
Reference in New Issue