Move actual parsing of jbuilds to Gen_rules
This commit is contained in:
parent
c6b2169037
commit
4227e756bd
|
@ -1778,11 +1778,21 @@ module Gen(P : Params) = struct
|
|||
end)
|
||||
end
|
||||
|
||||
let gen ~contexts ~file_tree ~tree ~stanzas ~packages
|
||||
?(filter_out_optional_stanzas_with_missing_deps=true) () =
|
||||
let gen ~contexts ?(filter_out_optional_stanzas_with_missing_deps=true) conf =
|
||||
let { Jbuild_load. file_tree; tree; jbuilds; packages } = conf in
|
||||
let alias_store = Alias.Store.create () in
|
||||
let rules =
|
||||
List.concat_map contexts ~f:(fun context ->
|
||||
let stanzas =
|
||||
List.map jbuilds ~f:(fun { Jbuild_load.Jbuild. path
|
||||
; version
|
||||
; sexps
|
||||
; visible_packages
|
||||
} ->
|
||||
(path,
|
||||
List.filter_map sexps ~f:(Stanza.select version)
|
||||
|> Stanza.resolve_packages ~dir:path ~visible_packages))
|
||||
in
|
||||
let module M =
|
||||
Gen(struct
|
||||
let context = context
|
||||
|
|
|
@ -1,11 +1,7 @@
|
|||
open Import
|
||||
open! Import
|
||||
|
||||
val gen
|
||||
: contexts:Context.t list
|
||||
-> file_tree:File_tree.t
|
||||
-> tree:Alias.tree
|
||||
-> stanzas:(Path.t * Jbuild_types.Stanza.t list) list
|
||||
-> packages:Package.t String_map.t
|
||||
-> ?filter_out_optional_stanzas_with_missing_deps:bool (** default: true *)
|
||||
-> unit
|
||||
-> Jbuild_load.conf
|
||||
-> Build_interpret.Rule.t list
|
||||
|
|
|
@ -1,10 +1,19 @@
|
|||
open Import
|
||||
open Jbuild_types
|
||||
|
||||
module Jbuild = struct
|
||||
type t =
|
||||
{ path : Path.t
|
||||
; version : Jbuild_types.Jbuilder_version.t
|
||||
; sexps : Sexp.Ast.t list
|
||||
; visible_packages : Package.t String_map.t
|
||||
}
|
||||
end
|
||||
|
||||
type conf =
|
||||
{ file_tree : File_tree.t
|
||||
; tree : Alias.tree
|
||||
; stanzas : (Path.t * Jbuild_types.Stanza.t list) list
|
||||
; jbuilds : Jbuild.t list
|
||||
; packages : Package.t String_map.t
|
||||
}
|
||||
|
||||
|
@ -23,11 +32,12 @@ let load ~dir ~visible_packages ~version =
|
|||
| _ :: (_, loc) :: _ ->
|
||||
Loc.fail loc "jbuilder_version specified too many times"
|
||||
in
|
||||
let stanzas =
|
||||
List.filter_map sexps ~f:(Stanza.select version)
|
||||
|> Stanza.resolve_packages ~dir ~visible_packages
|
||||
in
|
||||
(version, stanzas)
|
||||
{ Jbuild.
|
||||
path = dir
|
||||
; version
|
||||
; sexps
|
||||
; visible_packages
|
||||
}
|
||||
|
||||
let load () =
|
||||
let ftree = File_tree.load Path.root in
|
||||
|
@ -67,7 +77,7 @@ let load () =
|
|||
|> List.map ~f:(fun pkg -> (pkg.Package.path, pkg))
|
||||
|> Path.Map.of_alist_multi
|
||||
in
|
||||
let rec walk dir stanzas visible_packages version =
|
||||
let rec walk dir jbuilds visible_packages version =
|
||||
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
|
||||
|
@ -78,12 +88,12 @@ let load () =
|
|||
List.fold_left pkgs ~init:visible_packages ~f:(fun acc pkg ->
|
||||
String_map.add acc ~key:pkg.Package.name ~data:pkg)
|
||||
in
|
||||
let version, stanzas =
|
||||
let version, jbuilds =
|
||||
if String_set.mem "jbuild" files then
|
||||
let version, stanzas_here = load ~dir:path ~visible_packages ~version in
|
||||
(version, (path, stanzas_here) :: stanzas)
|
||||
let jbuild = load ~dir:path ~visible_packages ~version in
|
||||
(jbuild.version, jbuild :: jbuilds)
|
||||
else
|
||||
(version, stanzas)
|
||||
(version, jbuilds)
|
||||
in
|
||||
let sub_dirs =
|
||||
if String_set.mem "jbuild-ignore" files then
|
||||
|
@ -96,18 +106,18 @@ let load () =
|
|||
else
|
||||
sub_dirs
|
||||
in
|
||||
let children, stanzas =
|
||||
String_map.fold sub_dirs ~init:([], stanzas)
|
||||
~f:(fun ~key:_ ~data:dir (children, stanzas) ->
|
||||
let child, stanzas = walk dir stanzas visible_packages version in
|
||||
(child :: children, stanzas))
|
||||
let children, jbuilds =
|
||||
String_map.fold sub_dirs ~init:([], jbuilds)
|
||||
~f:(fun ~key:_ ~data:dir (children, jbuilds) ->
|
||||
let child, jbuilds = walk dir jbuilds visible_packages version in
|
||||
(child :: children, jbuilds))
|
||||
in
|
||||
(Alias.Node (path, children), stanzas)
|
||||
(Alias.Node (path, children), jbuilds)
|
||||
in
|
||||
let root = File_tree.root ftree in
|
||||
let tree, stanzas = walk root [] String_map.empty Jbuilder_version.latest_stable in
|
||||
let tree, jbuilds = walk root [] String_map.empty Jbuilder_version.latest_stable in
|
||||
{ file_tree = ftree
|
||||
; tree
|
||||
; stanzas
|
||||
; jbuilds
|
||||
; packages
|
||||
}
|
||||
|
|
|
@ -1,9 +1,18 @@
|
|||
open Import
|
||||
|
||||
module Jbuild : sig
|
||||
type t =
|
||||
{ path : Path.t
|
||||
; version : Jbuild_types.Jbuilder_version.t
|
||||
; sexps : Sexp.Ast.t list
|
||||
; visible_packages : Package.t String_map.t
|
||||
}
|
||||
end
|
||||
|
||||
type conf =
|
||||
{ file_tree : File_tree.t
|
||||
; tree : Alias.tree
|
||||
; stanzas : (Path.t * Jbuild_types.Stanza.t list) list
|
||||
; jbuilds : Jbuild.t list
|
||||
; packages : Package.t String_map.t
|
||||
}
|
||||
|
||||
|
|
25
src/main.ml
25
src/main.ml
|
@ -3,7 +3,7 @@ open Future
|
|||
|
||||
type setup =
|
||||
{ build_system : Build_system.t
|
||||
; stanzas : (Path.t * Jbuild_types.Stanza.t list) list
|
||||
; jbuilds : Jbuild_load.Jbuild.t list
|
||||
; contexts : Context.t list
|
||||
; packages : Package.t String_map.t
|
||||
}
|
||||
|
@ -14,7 +14,7 @@ let package_install_file { packages; _ } pkg =
|
|||
| Some p -> Ok (Path.relative p.path (p.name ^ ".install"))
|
||||
|
||||
let setup ?filter_out_optional_stanzas_with_missing_deps ?workspace () =
|
||||
let { Jbuild_load. file_tree; tree; stanzas; packages } = Jbuild_load.load () in
|
||||
let conf = Jbuild_load.load () in
|
||||
let workspace =
|
||||
match workspace with
|
||||
| Some w -> w
|
||||
|
@ -31,20 +31,20 @@ let setup ?filter_out_optional_stanzas_with_missing_deps ?workspace () =
|
|||
Context.create_for_opam ~name ~switch ?root ()))
|
||||
>>= fun contexts ->
|
||||
let rules =
|
||||
Gen_rules.gen ~contexts ~file_tree ~tree ~stanzas ~packages
|
||||
?filter_out_optional_stanzas_with_missing_deps ()
|
||||
Gen_rules.gen conf ~contexts
|
||||
?filter_out_optional_stanzas_with_missing_deps
|
||||
in
|
||||
let build_system = Build_system.create ~file_tree ~rules in
|
||||
let build_system = Build_system.create ~file_tree:conf.file_tree ~rules in
|
||||
return { build_system
|
||||
; stanzas
|
||||
; jbuilds = conf.jbuilds
|
||||
; contexts
|
||||
; packages
|
||||
; packages = conf.packages
|
||||
}
|
||||
|
||||
let external_lib_deps ?log ~packages () =
|
||||
Future.Scheduler.go ?log
|
||||
(setup () ~filter_out_optional_stanzas_with_missing_deps:false
|
||||
>>| fun ({ build_system = bs; stanzas; _ } as setup) ->
|
||||
>>| fun ({ build_system = bs; jbuilds; _ } as setup) ->
|
||||
let install_files =
|
||||
List.map packages ~f:(fun pkg ->
|
||||
match package_install_file setup pkg with
|
||||
|
@ -54,6 +54,15 @@ let external_lib_deps ?log ~packages () =
|
|||
Path.Map.map
|
||||
(Build_system.all_lib_deps bs install_files)
|
||||
~f:(fun deps ->
|
||||
let stanzas =
|
||||
List.map jbuilds ~f:(fun { Jbuild_load.Jbuild. path
|
||||
; version
|
||||
; sexps
|
||||
; _
|
||||
} ->
|
||||
(path,
|
||||
List.filter_map sexps ~f:(Jbuild_types.Stanza.select version)))
|
||||
in
|
||||
let internals = Jbuild_types.Stanza.lib_names stanzas in
|
||||
String_map.filter deps ~f:(fun name _ -> not (String_set.mem name internals))))
|
||||
|
||||
|
|
|
@ -2,7 +2,7 @@ open! Import
|
|||
|
||||
type setup =
|
||||
{ build_system : Build_system.t
|
||||
; stanzas : (Path.t * Jbuild_types.Stanza.t list) list
|
||||
; jbuilds : Jbuild_load.Jbuild.t list
|
||||
; contexts : Context.t list
|
||||
; packages : Package.t String_map.t
|
||||
}
|
||||
|
|
Loading…
Reference in New Issue