diff --git a/bin/main.ml b/bin/main.ml index 73010a45..d3d28bae 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -153,7 +153,7 @@ let resolve_targets (setup : Main.setup) user_targets = [File path] else 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 if Build_system.is_target setup.build_system path then Some (File path) @@ -251,12 +251,12 @@ let install_uninstall ~what = (List.map missing_install_files ~f:(sprintf "- %s"))) (String.concat ~sep:" " (List.map pkgs ~f:(sprintf "%s.install"))) end; - (match setup.all_contexts, prefix with + (match setup.contexts, prefix with | _ :: _ :: _, Some _ -> die "Cannot specify --prefix when installing into multiple contexts!" | _ -> ()); 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 -> Future.all_unit (List.map install_files ~f:(fun path -> diff --git a/src/main.ml b/src/main.ml index 07a9e656..7fffc671 100644 --- a/src/main.ml +++ b/src/main.ml @@ -4,8 +4,7 @@ open Future type setup = { build_system : Build_system.t ; stanzas : (Path.t * Jbuild_types.Stanza.t list) list - ; context : Context.t - ; all_contexts : Context.t list + ; contexts : Context.t list ; packages : Package.t String_map.t } @@ -14,20 +13,23 @@ let package_install_file { packages; _ } pkg = | None -> Error () | 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 - (if Sys.file_exists "jbuild-workspace" then - Future.all - (List.map (Workspace.load "jbuild-workspace") - ~f:(fun { Workspace.Context. name; switch; root } -> - Context.create_for_opam ~name ~switch ?root ())) - else - return []) + let workspace = + match workspace with + | Some w -> w + | None -> + if Sys.file_exists "jbuild-workspace" then + Workspace.load "jbuild-workspace" + 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 -> - (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 = Gen_rules.gen ~contexts ~file_tree ~tree ~stanzas ~packages ?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 return { build_system ; stanzas - ; context = default_context - ; all_contexts = contexts + ; contexts ; packages } @@ -117,7 +118,7 @@ let bootstrap () = ] anon "Usage: boot.exe [-j JOBS] [--dev]\nOptions are:"; 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")]) in try diff --git a/src/main.mli b/src/main.mli index caed131f..7bea65b1 100644 --- a/src/main.mli +++ b/src/main.mli @@ -1,11 +1,10 @@ open! Import type setup = - { build_system : Build_system.t - ; stanzas : (Path.t * Jbuild_types.Stanza.t list) list - ; context : Context.t - ; all_contexts : Context.t list - ; packages : Package.t String_map.t + { build_system : Build_system.t + ; stanzas : (Path.t * Jbuild_types.Stanza.t list) list + ; contexts : Context.t list + ; packages : Package.t String_map.t } (* Returns [Error ()] if [pkg] is unknown *) @@ -13,6 +12,7 @@ val package_install_file : setup -> string -> (Path.t, unit) result val setup : ?filter_out_optional_stanzas_with_missing_deps:bool + -> ?workspace:Workspace.t -> unit -> setup Future.t val external_lib_deps diff --git a/src/workspace.ml b/src/workspace.ml index 07899d96..a0744580 100644 --- a/src/workspace.ml +++ b/src/workspace.ml @@ -6,21 +6,33 @@ let of_sexp_error = Sexp.of_sexp_error let of_sexp_errorf = Sexp.of_sexp_errorf module Context = struct - type t = - { name : string - ; switch : string - ; root : string option - } + module Opam = struct + type t = + { name : string + ; switch : string + ; root : string option + } - let t = - record - (field "switch" string >>= fun switch -> - field "name" string ~default:switch >>= fun name -> - field_o "root" string >>= fun root -> - return { switch - ; name - ; root - }) + let t = + record + (field "switch" string >>= fun switch -> + field "name" string ~default:switch >>= fun name -> + field_o "root" string >>= fun root -> + return { switch + ; name + ; 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 type t = Context.t list @@ -32,13 +44,14 @@ let t sexps = [ cstr "context" [Context.t] (fun x -> x) ] sexp in - begin match ctx.name with - | ".aliases" | "log" as s -> - of_sexp_errorf sexp "%S is not allowed as a build context name" s + let name = Context.name ctx in + begin match name with + | ".aliases" | "log" -> + of_sexp_errorf sexp "%S is not allowed as a build context name" name | _ -> () end; - if List.exists acc ~f:(fun c -> c.Context.name = ctx.name) then - of_sexp_errorf sexp "second definition of build context %S" ctx.name; + if List.exists acc ~f:(fun c -> Context.name c = name) then + of_sexp_errorf sexp "second definition of build context %S" name; ctx :: acc) |> List.rev