Small refactoring of jbuild_load.ml

Signed-off-by: Jeremie Dimino <jeremie@dimino.org>
This commit is contained in:
Jeremie Dimino 2018-07-19 11:47:12 +01:00 committed by Rudi Grinberg
parent 4bd1bcbb3a
commit 8d5bd6819f
1 changed files with 26 additions and 43 deletions

View File

@ -1,14 +1,6 @@
open Import open Import
open Jbuild open Jbuild
let filter_stanzas ~ignore_promoted_rules stanzas =
if ignore_promoted_rules then
List.filter stanzas ~f:(function
| Rule { mode = Promote; _ } -> false
| _ -> true)
else
stanzas
module Jbuild = struct module Jbuild = struct
type t = type t =
{ dir : Path.t { dir : Path.t
@ -16,6 +8,22 @@ module Jbuild = struct
; stanzas : Stanzas.t ; stanzas : Stanzas.t
; kind : File_tree.Dune_file.Kind.t ; kind : File_tree.Dune_file.Kind.t
} }
let parse sexps ~dir ~file ~project ~kind ~ignore_promoted_rules =
let stanzas = Stanzas.parse ~file ~kind project sexps in
let stanzas =
if ignore_promoted_rules then
List.filter stanzas ~f:(function
| Rule { mode = Promote; _ } -> false
| _ -> true)
else
stanzas
in
{ dir
; project
; stanzas
; kind
}
end end
module Jbuilds = struct module Jbuilds = struct
@ -198,19 +206,10 @@ end
die "@{<error>Error:@} %s failed to produce a valid jbuild file.\n\ die "@{<error>Error:@} %s failed to produce a valid jbuild file.\n\
Did you forgot to call [Jbuild_plugin.V*.send]?" Did you forgot to call [Jbuild_plugin.V*.send]?"
(Path.to_string file); (Path.to_string file);
let stanzas =
Io.Sexp.load generated_jbuild ~mode:Many
~lexer:(File_tree.Dune_file.Kind.lexer kind)
|> Stanzas.parse project ~file:generated_jbuild ~kind
|> filter_stanzas ~ignore_promoted_rules
in
Fiber.return Fiber.return
{ Jbuild. (Io.Sexp.load generated_jbuild ~mode:Many
dir ~lexer:(File_tree.Dune_file.Kind.lexer kind)
; project |> Jbuild.parse ~dir ~file ~project ~kind ~ignore_promoted_rules))
; kind
; stanzas
})
>>| fun dynamic -> >>| fun dynamic ->
static @ dynamic static @ dynamic
end end
@ -226,17 +225,10 @@ let interpret ~dir ~project ~ignore_promoted_rules
~(dune_file:File_tree.Dune_file.t) = ~(dune_file:File_tree.Dune_file.t) =
match dune_file.contents with match dune_file.contents with
| Plain p -> | Plain p ->
let stanzas =
Stanzas.parse project p.sexps ~file:p.path ~kind:dune_file.kind
|> filter_stanzas ~ignore_promoted_rules
in
let jbuild = let jbuild =
Jbuilds.Literal Jbuilds.Literal
{ dir (Jbuild.parse p.sexps ~dir ~file:p.path ~project ~kind:dune_file.kind
; project ~ignore_promoted_rules)
; stanzas
; kind = dune_file.kind
}
in in
p.sexps <- []; p.sexps <- [];
jbuild jbuild
@ -267,20 +259,14 @@ let load ?extra_ignored_subtrees ?(ignore_promoted_rules=false) () =
(Path.to_string_maybe_quoted (Package.opam_file a)) (Path.to_string_maybe_quoted (Package.opam_file a))
(Path.to_string_maybe_quoted (Package.opam_file b)))) (Path.to_string_maybe_quoted (Package.opam_file b))))
in in
let projects =
List.map projects ~f:(fun (p : Dune_project.t) ->
(Path.of_local p.root, p))
|> Path.Map.of_list_exn
in
assert (Path.Map.mem projects Path.root);
let rec walk dir jbuilds project = let rec walk dir jbuilds =
if File_tree.Dir.ignored dir then if File_tree.Dir.ignored dir then
jbuilds jbuilds
else begin else begin
let path = File_tree.Dir.path dir in let path = File_tree.Dir.path dir in
let sub_dirs = File_tree.Dir.sub_dirs dir in let sub_dirs = File_tree.Dir.sub_dirs dir in
let project = Option.value (Path.Map.find projects path) ~default:project in let project = File_tree.Dir.project dir in
let jbuilds = let jbuilds =
match File_tree.Dir.dune_file dir with match File_tree.Dir.dune_file dir with
| None -> jbuilds | None -> jbuilds
@ -291,15 +277,12 @@ let load ?extra_ignored_subtrees ?(ignore_promoted_rules=false) () =
jbuild :: jbuilds jbuild :: jbuilds
in in
String.Map.fold sub_dirs ~init:jbuilds String.Map.fold sub_dirs ~init:jbuilds
~f:(fun dir jbuilds -> walk dir jbuilds project) ~f:(fun dir jbuilds -> walk dir jbuilds)
end end
in in
let jbuilds = let jbuilds = walk (File_tree.root ftree) [] in
let project = Option.value_exn (Path.Map.find projects Path.root) in
walk (File_tree.root ftree) [] project
in
{ file_tree = ftree { file_tree = ftree
; jbuilds = { jbuilds; ignore_promoted_rules } ; jbuilds = { jbuilds; ignore_promoted_rules }
; packages ; packages
; projects = Path.Map.values projects ; projects
} }