Don't force to have a default context
This commit is contained in:
parent
63ff502114
commit
01e76a64eb
|
@ -153,7 +153,7 @@ let resolve_targets (setup : Main.setup) user_targets =
|
||||||
[File path]
|
[File path]
|
||||||
else
|
else
|
||||||
match
|
match
|
||||||
List.filter_map setup.all_contexts ~f:(fun ctx ->
|
List.filter_map setup.contexts ~f:(fun ctx ->
|
||||||
let path = Path.append ctx.Context.build_dir path in
|
let path = Path.append ctx.Context.build_dir path in
|
||||||
if Build_system.is_target setup.build_system path then
|
if Build_system.is_target setup.build_system path then
|
||||||
Some (File path)
|
Some (File path)
|
||||||
|
@ -251,12 +251,12 @@ let install_uninstall ~what =
|
||||||
(List.map missing_install_files ~f:(sprintf "- %s")))
|
(List.map missing_install_files ~f:(sprintf "- %s")))
|
||||||
(String.concat ~sep:" " (List.map pkgs ~f:(sprintf "%s.install")))
|
(String.concat ~sep:" " (List.map pkgs ~f:(sprintf "%s.install")))
|
||||||
end;
|
end;
|
||||||
(match setup.all_contexts, prefix with
|
(match setup.contexts, prefix with
|
||||||
| _ :: _ :: _, Some _ ->
|
| _ :: _ :: _, Some _ ->
|
||||||
die "Cannot specify --prefix when installing into multiple contexts!"
|
die "Cannot specify --prefix when installing into multiple contexts!"
|
||||||
| _ -> ());
|
| _ -> ());
|
||||||
Future.all_unit
|
Future.all_unit
|
||||||
(List.map setup.all_contexts ~f:(fun context ->
|
(List.map setup.contexts ~f:(fun context ->
|
||||||
get_prefix context ~from_command_line:prefix >>= fun prefix ->
|
get_prefix context ~from_command_line:prefix >>= fun prefix ->
|
||||||
Future.all_unit
|
Future.all_unit
|
||||||
(List.map install_files ~f:(fun path ->
|
(List.map install_files ~f:(fun path ->
|
||||||
|
|
35
src/main.ml
35
src/main.ml
|
@ -4,8 +4,7 @@ open Future
|
||||||
type setup =
|
type setup =
|
||||||
{ build_system : Build_system.t
|
{ build_system : Build_system.t
|
||||||
; stanzas : (Path.t * Jbuild_types.Stanza.t list) list
|
; stanzas : (Path.t * Jbuild_types.Stanza.t list) list
|
||||||
; context : Context.t
|
; contexts : Context.t list
|
||||||
; all_contexts : Context.t list
|
|
||||||
; packages : Package.t String_map.t
|
; packages : Package.t String_map.t
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -14,20 +13,23 @@ let package_install_file { packages; _ } pkg =
|
||||||
| None -> Error ()
|
| None -> Error ()
|
||||||
| Some p -> Ok (Path.relative p.path (p.name ^ ".install"))
|
| Some p -> Ok (Path.relative p.path (p.name ^ ".install"))
|
||||||
|
|
||||||
let setup ?filter_out_optional_stanzas_with_missing_deps () =
|
let setup ?filter_out_optional_stanzas_with_missing_deps ?workspace () =
|
||||||
let { Jbuild_load. file_tree; tree; stanzas; packages } = Jbuild_load.load () in
|
let { Jbuild_load. file_tree; tree; stanzas; packages } = Jbuild_load.load () in
|
||||||
(if Sys.file_exists "jbuild-workspace" then
|
let workspace =
|
||||||
Future.all
|
match workspace with
|
||||||
(List.map (Workspace.load "jbuild-workspace")
|
| Some w -> w
|
||||||
~f:(fun { Workspace.Context. name; switch; root } ->
|
| None ->
|
||||||
Context.create_for_opam ~name ~switch ?root ()))
|
if Sys.file_exists "jbuild-workspace" then
|
||||||
else
|
Workspace.load "jbuild-workspace"
|
||||||
return [])
|
else
|
||||||
|
[Default]
|
||||||
|
in
|
||||||
|
Future.all
|
||||||
|
(List.map workspace ~f:(function
|
||||||
|
| Workspace.Context.Default -> Lazy.force Context.default
|
||||||
|
| Opam { name; switch; root } ->
|
||||||
|
Context.create_for_opam ~name ~switch ?root ()))
|
||||||
>>= fun contexts ->
|
>>= fun contexts ->
|
||||||
(match List.find contexts ~f:(fun c -> c.name = "default") with
|
|
||||||
| None -> Lazy.force Context.default
|
|
||||||
| Some c -> return c)
|
|
||||||
>>= fun default_context ->
|
|
||||||
let rules =
|
let rules =
|
||||||
Gen_rules.gen ~contexts ~file_tree ~tree ~stanzas ~packages
|
Gen_rules.gen ~contexts ~file_tree ~tree ~stanzas ~packages
|
||||||
?filter_out_optional_stanzas_with_missing_deps ()
|
?filter_out_optional_stanzas_with_missing_deps ()
|
||||||
|
@ -35,8 +37,7 @@ let setup ?filter_out_optional_stanzas_with_missing_deps () =
|
||||||
let build_system = Build_system.create ~file_tree ~rules in
|
let build_system = Build_system.create ~file_tree ~rules in
|
||||||
return { build_system
|
return { build_system
|
||||||
; stanzas
|
; stanzas
|
||||||
; context = default_context
|
; contexts
|
||||||
; all_contexts = contexts
|
|
||||||
; packages
|
; packages
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -117,7 +118,7 @@ let bootstrap () =
|
||||||
]
|
]
|
||||||
anon "Usage: boot.exe [-j JOBS] [--dev]\nOptions are:";
|
anon "Usage: boot.exe [-j JOBS] [--dev]\nOptions are:";
|
||||||
Future.Scheduler.go ~log:(create_log ())
|
Future.Scheduler.go ~log:(create_log ())
|
||||||
(setup () >>= fun { build_system = bs; _ } ->
|
(setup ~workspace:[Default] () >>= 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
|
||||||
|
|
10
src/main.mli
10
src/main.mli
|
@ -1,11 +1,10 @@
|
||||||
open! Import
|
open! Import
|
||||||
|
|
||||||
type setup =
|
type setup =
|
||||||
{ build_system : Build_system.t
|
{ build_system : Build_system.t
|
||||||
; stanzas : (Path.t * Jbuild_types.Stanza.t list) list
|
; stanzas : (Path.t * Jbuild_types.Stanza.t list) list
|
||||||
; context : Context.t
|
; contexts : Context.t list
|
||||||
; all_contexts : Context.t list
|
; packages : Package.t String_map.t
|
||||||
; packages : Package.t String_map.t
|
|
||||||
}
|
}
|
||||||
|
|
||||||
(* Returns [Error ()] if [pkg] is unknown *)
|
(* Returns [Error ()] if [pkg] is unknown *)
|
||||||
|
@ -13,6 +12,7 @@ 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
|
||||||
|
-> ?workspace:Workspace.t
|
||||||
-> unit
|
-> unit
|
||||||
-> setup Future.t
|
-> setup Future.t
|
||||||
val external_lib_deps
|
val external_lib_deps
|
||||||
|
|
|
@ -6,21 +6,33 @@ let of_sexp_error = Sexp.of_sexp_error
|
||||||
let of_sexp_errorf = Sexp.of_sexp_errorf
|
let of_sexp_errorf = Sexp.of_sexp_errorf
|
||||||
|
|
||||||
module Context = struct
|
module Context = struct
|
||||||
type t =
|
module Opam = struct
|
||||||
{ name : string
|
type t =
|
||||||
; switch : string
|
{ name : string
|
||||||
; root : string option
|
; switch : string
|
||||||
}
|
; root : string option
|
||||||
|
}
|
||||||
|
|
||||||
let t =
|
let t =
|
||||||
record
|
record
|
||||||
(field "switch" string >>= fun switch ->
|
(field "switch" string >>= fun switch ->
|
||||||
field "name" string ~default:switch >>= fun name ->
|
field "name" string ~default:switch >>= fun name ->
|
||||||
field_o "root" string >>= fun root ->
|
field_o "root" string >>= fun root ->
|
||||||
return { switch
|
return { switch
|
||||||
; name
|
; name
|
||||||
; root
|
; root
|
||||||
})
|
})
|
||||||
|
end
|
||||||
|
|
||||||
|
type t = Default | Opam of Opam.t
|
||||||
|
|
||||||
|
let t = function
|
||||||
|
| Atom "default" -> Default
|
||||||
|
| sexp -> Opam (Opam.t sexp)
|
||||||
|
|
||||||
|
let name = function
|
||||||
|
| Default -> "default"
|
||||||
|
| Opam o -> o.name
|
||||||
end
|
end
|
||||||
|
|
||||||
type t = Context.t list
|
type t = Context.t list
|
||||||
|
@ -32,13 +44,14 @@ let t sexps =
|
||||||
[ cstr "context" [Context.t] (fun x -> x) ]
|
[ cstr "context" [Context.t] (fun x -> x) ]
|
||||||
sexp
|
sexp
|
||||||
in
|
in
|
||||||
begin match ctx.name with
|
let name = Context.name ctx in
|
||||||
| ".aliases" | "log" as s ->
|
begin match name with
|
||||||
of_sexp_errorf sexp "%S is not allowed as a build context name" s
|
| ".aliases" | "log" ->
|
||||||
|
of_sexp_errorf sexp "%S is not allowed as a build context name" name
|
||||||
| _ -> ()
|
| _ -> ()
|
||||||
end;
|
end;
|
||||||
if List.exists acc ~f:(fun c -> c.Context.name = ctx.name) then
|
if List.exists acc ~f:(fun c -> Context.name c = name) then
|
||||||
of_sexp_errorf sexp "second definition of build context %S" ctx.name;
|
of_sexp_errorf sexp "second definition of build context %S" name;
|
||||||
ctx :: acc)
|
ctx :: acc)
|
||||||
|> List.rev
|
|> List.rev
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue