Small refactoring of jbuild_load.ml
Signed-off-by: Jeremie Dimino <jeremie@dimino.org>
This commit is contained in:
parent
4bd1bcbb3a
commit
8d5bd6819f
|
@ -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
|
||||||
}
|
}
|
||||||
|
|
Loading…
Reference in New Issue