Don't require packages to be defined at the root
To match the manual
This commit is contained in:
parent
331b9dc14e
commit
fe929a07d7
40
bin/main.ml
40
bin/main.ml
|
@ -2,6 +2,7 @@ open Jbuilder
|
||||||
open Import
|
open Import
|
||||||
open Jbuilder_cmdliner.Cmdliner
|
open Jbuilder_cmdliner.Cmdliner
|
||||||
|
|
||||||
|
module Suggest = Jbuilder_cmdliner.Cmdliner_suggest
|
||||||
module Main = Jbuilder.Main
|
module Main = Jbuilder.Main
|
||||||
|
|
||||||
let (>>=) = Future.(>>=)
|
let (>>=) = Future.(>>=)
|
||||||
|
@ -74,8 +75,25 @@ let common =
|
||||||
|
|
||||||
let build_package pkg =
|
let build_package pkg =
|
||||||
Future.Scheduler.go ~log:(create_log ())
|
Future.Scheduler.go ~log:(create_log ())
|
||||||
(Main.setup () >>= fun (bs, _, _) ->
|
(Main.setup () >>= fun setup ->
|
||||||
Build_system.do_build_exn bs [Path.(relative root) (pkg ^ ".install")])
|
match Main.package_install_file setup pkg with
|
||||||
|
| Ok path ->
|
||||||
|
Build_system.do_build_exn setup.build_system
|
||||||
|
[path]
|
||||||
|
| Error () ->
|
||||||
|
match Suggest.value pkg (String_map.keys setup.packages) with
|
||||||
|
| [] -> die "Unknown package %s!" pkg
|
||||||
|
| pkgs ->
|
||||||
|
let rec mk_hint = function
|
||||||
|
| [a; b] -> sprintf "%s or %s" a b
|
||||||
|
| [a] -> a
|
||||||
|
| a :: l -> sprintf "%s, %s" a (mk_hint l)
|
||||||
|
| [] -> ""
|
||||||
|
in
|
||||||
|
die "Unknown package %s!\nHint: did you mean %s?"
|
||||||
|
pkg
|
||||||
|
(mk_hint pkgs)
|
||||||
|
)
|
||||||
|
|
||||||
let build_package =
|
let build_package =
|
||||||
let doc = "build a package in release mode" in
|
let doc = "build a package in release mode" in
|
||||||
|
@ -112,7 +130,7 @@ let external_lib_deps =
|
||||||
$ Arg.(non_empty & pos_all string [] name_))
|
$ Arg.(non_empty & pos_all string [] name_))
|
||||||
, Term.info "external-lib-deps" ~doc ~man:help_secs)
|
, Term.info "external-lib-deps" ~doc ~man:help_secs)
|
||||||
|
|
||||||
let resolve_targets bs (ctx : Context.t) user_targets =
|
let resolve_targets (setup : Main.setup)user_targets =
|
||||||
match user_targets with
|
match user_targets with
|
||||||
| [] -> []
|
| [] -> []
|
||||||
| _ ->
|
| _ ->
|
||||||
|
@ -122,9 +140,9 @@ let resolve_targets bs (ctx : Context.t) user_targets =
|
||||||
if Path.is_in_build_dir path then
|
if Path.is_in_build_dir path then
|
||||||
path
|
path
|
||||||
else if Path.is_local path &&
|
else if Path.is_local path &&
|
||||||
not (Build_system.is_target bs path) &&
|
not (Build_system.is_target setup.build_system path) &&
|
||||||
not (Path.exists path) then
|
not (Path.exists path) then
|
||||||
Path.append ctx.build_dir path
|
Path.append setup.context.build_dir path
|
||||||
else
|
else
|
||||||
path)
|
path)
|
||||||
in
|
in
|
||||||
|
@ -140,9 +158,9 @@ let build_targets ~name =
|
||||||
let go common targets =
|
let go common targets =
|
||||||
set_common common;
|
set_common common;
|
||||||
Future.Scheduler.go ~log:(create_log ())
|
Future.Scheduler.go ~log:(create_log ())
|
||||||
(Main.setup () >>= fun (bs, _, ctx) ->
|
(Main.setup () >>= fun setup ->
|
||||||
let targets = resolve_targets bs ctx targets in
|
let targets = resolve_targets setup targets in
|
||||||
Build_system.do_build_exn bs targets) in
|
Build_system.do_build_exn setup.build_system targets) in
|
||||||
( Term.(const go
|
( Term.(const go
|
||||||
$ common
|
$ common
|
||||||
$ Arg.(non_empty & pos_all string [] name_))
|
$ Arg.(non_empty & pos_all string [] name_))
|
||||||
|
@ -154,7 +172,7 @@ let runtest =
|
||||||
let go common dirs =
|
let go common dirs =
|
||||||
set_common common;
|
set_common common;
|
||||||
Future.Scheduler.go ~log:(create_log ())
|
Future.Scheduler.go ~log:(create_log ())
|
||||||
(Main.setup () >>= fun (bs, _, ctx) ->
|
(Main.setup () >>= fun setup ->
|
||||||
let dirs =
|
let dirs =
|
||||||
match dirs with
|
match dirs with
|
||||||
| [] -> [Path.root]
|
| [] -> [Path.root]
|
||||||
|
@ -166,11 +184,11 @@ let runtest =
|
||||||
if Path.is_in_build_dir dir then
|
if Path.is_in_build_dir dir then
|
||||||
dir
|
dir
|
||||||
else
|
else
|
||||||
Path.append ctx.build_dir dir
|
Path.append setup.context.build_dir dir
|
||||||
in
|
in
|
||||||
Alias.file (Alias.runtest ~dir))
|
Alias.file (Alias.runtest ~dir))
|
||||||
in
|
in
|
||||||
Build_system.do_build_exn bs targets) in
|
Build_system.do_build_exn setup.build_system targets) in
|
||||||
( Term.(const go
|
( Term.(const go
|
||||||
$ common
|
$ common
|
||||||
$ Arg.(value & pos_all string [] name_))
|
$ Arg.(value & pos_all string [] name_))
|
||||||
|
|
|
@ -65,3 +65,12 @@ let fold t ~init ~f =
|
||||||
|
|
||||||
let find_dir t path =
|
let find_dir t path =
|
||||||
Path.Map.find path t.dirs
|
Path.Map.find path t.dirs
|
||||||
|
|
||||||
|
let file_exists t path fn =
|
||||||
|
match Path.Map.find path t.dirs with
|
||||||
|
| None -> false
|
||||||
|
| Some { files; _ } -> String_set.mem fn files
|
||||||
|
|
||||||
|
let exists t path =
|
||||||
|
Path.Map.mem path t.dirs ||
|
||||||
|
file_exists t (Path.parent path) (Path.basename path)
|
||||||
|
|
|
@ -18,3 +18,6 @@ val fold : t -> init:'a -> f:(Dir.t -> 'a -> 'a) -> 'a
|
||||||
val root : t -> Dir.t
|
val root : t -> Dir.t
|
||||||
|
|
||||||
val find_dir : t -> Path.t -> Dir.t option
|
val find_dir : t -> Path.t -> Dir.t option
|
||||||
|
|
||||||
|
val exists : t -> Path.t -> bool
|
||||||
|
val file_exists : t -> Path.t -> string -> bool
|
||||||
|
|
|
@ -73,7 +73,7 @@ module type Params = sig
|
||||||
val file_tree : File_tree.t
|
val file_tree : File_tree.t
|
||||||
val tree : Alias.tree
|
val tree : Alias.tree
|
||||||
val stanzas : (Path.t * Jbuild_types.Stanza.t list) list
|
val stanzas : (Path.t * Jbuild_types.Stanza.t list) list
|
||||||
val packages : string list
|
val packages : Path.t String_map.t
|
||||||
val filter_out_optional_stanzas_with_missing_deps : bool
|
val filter_out_optional_stanzas_with_missing_deps : bool
|
||||||
end
|
end
|
||||||
|
|
||||||
|
@ -1367,15 +1367,17 @@ module Gen(P : Params) = struct
|
||||||
List.map stanzas ~f:(fun s -> (ctx_dir, s)))
|
List.map stanzas ~f:(fun s -> (ctx_dir, s)))
|
||||||
|
|
||||||
let () =
|
let () =
|
||||||
List.iter P.packages ~f:(fun package ->
|
String_map.iter P.packages ~f:(fun ~key:package ~data:src_path ->
|
||||||
|
let path = Path.append ctx.build_dir src_path in
|
||||||
let meta_fn = "META." ^ package in
|
let meta_fn = "META." ^ package in
|
||||||
let meta_path = Path.relative ctx.build_dir meta_fn in
|
let meta_path = Path.relative path meta_fn in
|
||||||
let templ_fn = meta_fn ^ ".template" in
|
|
||||||
let template =
|
let template =
|
||||||
if Sys.file_exists templ_fn then
|
let templ_fn = meta_fn ^ ".template" in
|
||||||
Build.path (Path.(relative root) templ_fn)
|
let templ_path = Path.relative src_path templ_fn in
|
||||||
|
if File_tree.exists P.file_tree templ_path then
|
||||||
|
Build.path templ_path
|
||||||
>>^ fun () ->
|
>>^ fun () ->
|
||||||
lines_of_file templ_fn
|
lines_of_file (Path.to_string templ_path)
|
||||||
else
|
else
|
||||||
Build.return ["# JBUILDER_GEN"]
|
Build.return ["# JBUILDER_GEN"]
|
||||||
in
|
in
|
||||||
|
@ -1543,7 +1545,7 @@ module Gen(P : Params) = struct
|
||||||
List.exists [ "README"; "LICENSE"; "CHANGE"; "HISTORY"]
|
List.exists [ "README"; "LICENSE"; "CHANGE"; "HISTORY"]
|
||||||
~f:(fun prefix -> String.is_prefix fn ~prefix)
|
~f:(fun prefix -> String.is_prefix fn ~prefix)
|
||||||
|
|
||||||
let install_file package =
|
let install_file package_path package =
|
||||||
let entries =
|
let entries =
|
||||||
List.concat_map stanzas_to_consider_for_install ~f:(fun (dir, stanza) ->
|
List.concat_map stanzas_to_consider_for_install ~f:(fun (dir, stanza) ->
|
||||||
match stanza with
|
match stanza with
|
||||||
|
@ -1576,18 +1578,15 @@ module Gen(P : Params) = struct
|
||||||
acc)
|
acc)
|
||||||
in
|
in
|
||||||
let entries =
|
let entries =
|
||||||
let opam = Path.of_string "opam" in
|
let opam = Path.relative package_path (package ^ ".opam") in
|
||||||
if Path.exists opam then
|
Install.Entry.make Lib opam ~dst:"opam" :: entries
|
||||||
Install.Entry.make Lib opam :: entries
|
|
||||||
else
|
|
||||||
entries
|
|
||||||
in
|
in
|
||||||
let entries =
|
let entries =
|
||||||
let meta_fn = "META." ^ package in
|
let meta_fn = "META." ^ package in
|
||||||
if Sys.file_exists meta_fn ||
|
if File_tree.file_exists P.file_tree package_path meta_fn ||
|
||||||
Sys.file_exists (meta_fn ^ ".template") ||
|
File_tree.file_exists P.file_tree package_path (meta_fn ^ ".template") ||
|
||||||
List.exists entries ~f:(fun (e : Install.Entry.t) -> e.section = Lib) then
|
List.exists entries ~f:(fun (e : Install.Entry.t) -> e.section = Lib) then
|
||||||
let meta = Path.relative ctx.build_dir meta_fn in
|
let meta = Path.append ctx.build_dir (Path.relative package_path meta_fn) in
|
||||||
Install.Entry.make Lib meta ~dst:"META" :: entries
|
Install.Entry.make Lib meta ~dst:"META" :: entries
|
||||||
else
|
else
|
||||||
entries
|
entries
|
||||||
|
@ -1598,16 +1597,17 @@ module Gen(P : Params) = struct
|
||||||
Build.create_file ~target:fn (fun () ->
|
Build.create_file ~target:fn (fun () ->
|
||||||
Install.write_install_file fn entries))
|
Install.write_install_file fn entries))
|
||||||
|
|
||||||
let () = List.iter P.packages ~f:install_file
|
let () = String_map.iter P.packages ~f:(fun ~key:package ~data:package_path ->
|
||||||
|
install_file package_path package)
|
||||||
|
|
||||||
let () =
|
let () =
|
||||||
if Path.basename ctx.build_dir = "default" then
|
if Path.basename ctx.build_dir = "default" then
|
||||||
List.iter P.packages ~f:(fun pkg ->
|
String_map.iter P.packages ~f:(fun ~key:pkg ~data:path ->
|
||||||
let fn = pkg ^ ".install" in
|
let install_file = Path.relative path (pkg ^ ".install") in
|
||||||
add_rule
|
add_rule
|
||||||
(Build.copy
|
(Build.copy
|
||||||
~src:(Path.relative ctx.build_dir fn)
|
~src:(Path.append ctx.build_dir install_file)
|
||||||
~dst:(Path.relative Path.root fn)))
|
~dst:install_file))
|
||||||
end
|
end
|
||||||
|
|
||||||
let gen ~context ~file_tree ~tree ~stanzas ~packages
|
let gen ~context ~file_tree ~tree ~stanzas ~packages
|
||||||
|
|
|
@ -1,9 +1,11 @@
|
||||||
|
open Import
|
||||||
|
|
||||||
val gen
|
val gen
|
||||||
: context:Context.t
|
: context:Context.t
|
||||||
-> file_tree:File_tree.t
|
-> file_tree:File_tree.t
|
||||||
-> tree:Alias.tree
|
-> tree:Alias.tree
|
||||||
-> stanzas:(Path.t * Jbuild_types.Stanza.t list) list
|
-> stanzas:(Path.t * Jbuild_types.Stanza.t list) list
|
||||||
-> packages:string list
|
-> packages:Path.t String_map.t
|
||||||
-> ?filter_out_optional_stanzas_with_missing_deps:bool (** default: true *)
|
-> ?filter_out_optional_stanzas_with_missing_deps:bool (** default: true *)
|
||||||
-> unit
|
-> unit
|
||||||
-> (unit, unit) Build.t list
|
-> (unit, unit) Build.t list
|
||||||
|
|
|
@ -5,13 +5,13 @@ type conf =
|
||||||
{ file_tree : File_tree.t
|
{ file_tree : File_tree.t
|
||||||
; tree : Alias.tree
|
; tree : Alias.tree
|
||||||
; stanzas : (Path.t * Jbuild_types.Stanza.t list) list
|
; stanzas : (Path.t * Jbuild_types.Stanza.t list) list
|
||||||
; packages : string list
|
; packages : Path.t String_map.t
|
||||||
}
|
}
|
||||||
|
|
||||||
let load fn ~dir = (dir, Sexp_load.many fn Stanza.t)
|
let load fn ~dir = (dir, Sexp_load.many fn Stanza.t)
|
||||||
|
|
||||||
let load () =
|
let load () =
|
||||||
let rec walk dir stanzas =
|
let rec walk dir stanzas packages =
|
||||||
let path = File_tree.Dir.path dir in
|
let path = File_tree.Dir.path dir in
|
||||||
let files = File_tree.Dir.files dir in
|
let files = File_tree.Dir.files dir in
|
||||||
let sub_dirs = File_tree.Dir.sub_dirs dir in
|
let sub_dirs = File_tree.Dir.sub_dirs dir in
|
||||||
|
@ -26,10 +26,11 @@ let load () =
|
||||||
else
|
else
|
||||||
sub_dirs
|
sub_dirs
|
||||||
in
|
in
|
||||||
let children, stanzas =
|
let children, stanzas, packages =
|
||||||
String_map.fold sub_dirs ~init:([], stanzas) ~f:(fun ~key:_ ~data:dir (children, stanzas) ->
|
String_map.fold sub_dirs ~init:([], stanzas, [])
|
||||||
let child, stanzas = walk dir stanzas in
|
~f:(fun ~key:_ ~data:dir (children, stanzas, packages) ->
|
||||||
(child :: children, stanzas))
|
let child, stanzas, packages = walk dir stanzas packages in
|
||||||
|
(child :: children, stanzas, packages))
|
||||||
in
|
in
|
||||||
let stanzas =
|
let stanzas =
|
||||||
if String_set.mem "jbuild" files then
|
if String_set.mem "jbuild" files then
|
||||||
|
@ -37,16 +38,28 @@ let load () =
|
||||||
else
|
else
|
||||||
stanzas
|
stanzas
|
||||||
in
|
in
|
||||||
(Alias.Node (path, children), stanzas)
|
let packages =
|
||||||
|
String_set.fold files ~init:packages ~f:(fun fn acc ->
|
||||||
|
match Filename.split_ext fn with
|
||||||
|
| Some (pkg, ".opam") -> (pkg, path) :: acc
|
||||||
|
| _ -> acc)
|
||||||
|
in
|
||||||
|
(Alias.Node (path, children), stanzas, packages)
|
||||||
in
|
in
|
||||||
let ftree = File_tree.load Path.root in
|
let ftree = File_tree.load Path.root in
|
||||||
let root = File_tree.root ftree in
|
let root = File_tree.root ftree in
|
||||||
let tree, stanzas = walk root [] in
|
let tree, stanzas, packages = walk root [] [] in
|
||||||
let packages =
|
let packages =
|
||||||
String_set.fold (File_tree.Dir.files root) ~init:[] ~f:(fun fn acc ->
|
String_map.of_alist_multi packages
|
||||||
match Filename.split_ext fn with
|
|> String_map.mapi ~f:(fun pkg dirs ->
|
||||||
| Some (pkg, ".opam") -> pkg :: acc
|
match dirs with
|
||||||
| _ -> acc)
|
| [dir] -> dir
|
||||||
|
| _ ->
|
||||||
|
die "Too many opam files for package %S:\n%s"
|
||||||
|
pkg
|
||||||
|
(String.concat ~sep:"\n"
|
||||||
|
(List.map dirs ~f:(fun dir ->
|
||||||
|
sprintf "- %s.opam" (Path.to_string dir)))))
|
||||||
in
|
in
|
||||||
{ file_tree = ftree
|
{ file_tree = ftree
|
||||||
; tree
|
; tree
|
||||||
|
|
|
@ -1,9 +1,10 @@
|
||||||
|
open Import
|
||||||
|
|
||||||
type conf =
|
type conf =
|
||||||
{ file_tree : File_tree.t
|
{ file_tree : File_tree.t
|
||||||
; tree : Alias.tree
|
; tree : Alias.tree
|
||||||
; stanzas : (Path.t * Jbuild_types.Stanza.t list) list
|
; stanzas : (Path.t * Jbuild_types.Stanza.t list) list
|
||||||
; packages : string list
|
; packages : Path.t String_map.t
|
||||||
}
|
}
|
||||||
|
|
||||||
val load : unit -> conf
|
val load : unit -> conf
|
||||||
|
|
38
src/main.ml
38
src/main.ml
|
@ -1,24 +1,44 @@
|
||||||
open Import
|
open Import
|
||||||
open Future
|
open Future
|
||||||
|
|
||||||
|
type setup =
|
||||||
|
{ build_system : Build_system.t
|
||||||
|
; stanzas : (Path.t * Jbuild_types.Stanza.t list) list
|
||||||
|
; context : Context.t
|
||||||
|
; packages : Path.t String_map.t
|
||||||
|
}
|
||||||
|
|
||||||
|
let package_install_file { packages; _ } pkg =
|
||||||
|
match String_map.find pkg packages with
|
||||||
|
| None -> Error ()
|
||||||
|
| Some path -> Ok (Path.relative path (pkg ^ ".install"))
|
||||||
|
|
||||||
let setup ?filter_out_optional_stanzas_with_missing_deps () =
|
let setup ?filter_out_optional_stanzas_with_missing_deps () =
|
||||||
let { Jbuild_load. file_tree; tree; stanzas; packages } = Jbuild_load.load () in
|
let { Jbuild_load. file_tree; tree; stanzas; packages } = Jbuild_load.load () in
|
||||||
Lazy.force Context.default >>= fun ctx ->
|
Lazy.force Context.default >>= fun context ->
|
||||||
let rules =
|
let rules =
|
||||||
Gen_rules.gen ~context:ctx ~file_tree ~tree ~stanzas ~packages
|
Gen_rules.gen ~context ~file_tree ~tree ~stanzas ~packages
|
||||||
?filter_out_optional_stanzas_with_missing_deps ()
|
?filter_out_optional_stanzas_with_missing_deps ()
|
||||||
in
|
in
|
||||||
let bs = Build_system.create ~file_tree ~rules in
|
let build_system = Build_system.create ~file_tree ~rules in
|
||||||
return (bs, stanzas, ctx)
|
return { build_system
|
||||||
|
; stanzas
|
||||||
|
; context
|
||||||
|
; packages
|
||||||
|
}
|
||||||
|
|
||||||
let external_lib_deps ?log ~packages =
|
let external_lib_deps ?log ~packages =
|
||||||
Future.Scheduler.go ?log
|
Future.Scheduler.go ?log
|
||||||
(setup () ~filter_out_optional_stanzas_with_missing_deps:false
|
(setup () ~filter_out_optional_stanzas_with_missing_deps:false
|
||||||
>>| fun (bs, stanzas, _) ->
|
>>| fun ({ build_system = bs; stanzas; _ } as setup) ->
|
||||||
|
let install_files =
|
||||||
|
List.map packages ~f:(fun pkg ->
|
||||||
|
match package_install_file setup pkg with
|
||||||
|
| Ok path -> path
|
||||||
|
| Error () -> die "Unknown package %S" pkg)
|
||||||
|
in
|
||||||
Path.Map.map
|
Path.Map.map
|
||||||
(Build_system.all_lib_deps bs
|
(Build_system.all_lib_deps bs install_files)
|
||||||
(List.map packages ~f:(fun pkg ->
|
|
||||||
Path.(relative root) (pkg ^ ".install"))))
|
|
||||||
~f:(fun deps ->
|
~f:(fun deps ->
|
||||||
let internals = Jbuild_types.Stanza.lib_names stanzas in
|
let internals = Jbuild_types.Stanza.lib_names stanzas in
|
||||||
String_map.filter deps ~f:(fun name _ -> not (String_set.mem name internals))))
|
String_map.filter deps ~f:(fun name _ -> not (String_set.mem name internals))))
|
||||||
|
@ -80,7 +100,7 @@ let bootstrap () =
|
||||||
Arg.parse [ "-j", Set_int Clflags.concurrency, "JOBS concurrency" ]
|
Arg.parse [ "-j", Set_int Clflags.concurrency, "JOBS concurrency" ]
|
||||||
anon "Usage: boot.exe [-j JOBS]\nOptions are:";
|
anon "Usage: boot.exe [-j JOBS]\nOptions are:";
|
||||||
Future.Scheduler.go ~log:(create_log ())
|
Future.Scheduler.go ~log:(create_log ())
|
||||||
(setup () >>= fun (bs, _, _) ->
|
(setup () >>= fun { build_system = bs; _ } ->
|
||||||
Build_system.do_build_exn bs [Path.(relative root) (pkg ^ ".install")])
|
Build_system.do_build_exn bs [Path.(relative root) (pkg ^ ".install")])
|
||||||
in
|
in
|
||||||
try
|
try
|
||||||
|
|
14
src/main.mli
14
src/main.mli
|
@ -1,9 +1,19 @@
|
||||||
open! Import
|
open! Import
|
||||||
|
|
||||||
|
type setup =
|
||||||
|
{ build_system : Build_system.t
|
||||||
|
; stanzas : (Path.t * Jbuild_types.Stanza.t list) list
|
||||||
|
; context : Context.t
|
||||||
|
; packages : Path.t String_map.t
|
||||||
|
}
|
||||||
|
|
||||||
|
(* Returns [Error ()] if [pkg] is unknown *)
|
||||||
|
val package_install_file : setup -> string -> (Path.t, unit) result
|
||||||
|
|
||||||
val setup
|
val setup
|
||||||
: ?filter_out_optional_stanzas_with_missing_deps:bool
|
: ?filter_out_optional_stanzas_with_missing_deps:bool
|
||||||
-> unit
|
-> unit
|
||||||
-> (Build_system.t * (Path.t * Jbuild_types.Stanza.t list) list * Context.t)
|
-> setup Future.t
|
||||||
Future.t
|
|
||||||
val external_lib_deps
|
val external_lib_deps
|
||||||
: ?log:out_channel
|
: ?log:out_channel
|
||||||
-> packages:string list
|
-> packages:string list
|
||||||
|
|
Loading…
Reference in New Issue