diff --git a/CHANGES.org b/CHANGES.org index 86327fad..4af90da4 100644 --- a/CHANGES.org +++ b/CHANGES.org @@ -12,7 +12,10 @@ You should now put =(jbuilder_version 1)= in a =jbuild= file at the root of your project to ensure forward compatibility -- Added a =runtest= command +- Added a few commands: + + =runtest= + + =install= + + =uninstall= - Added support for aliases (#7, Rudi Grinberg) diff --git a/bin/main.ml b/bin/main.ml index a4db00ff..dfd1ea09 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -85,16 +85,17 @@ let common = let dev = Arg.(value & flag & info ["dev"] ~docs) in Term.(const make $ concurrency $ drules $ ddep_path $ dfindlib $ dev) +let resolve_package_install setup pkg = + match Main.package_install_file setup pkg with + | Ok path -> path + | Error () -> + die "Unknown package %s!%s" pkg (hint pkg (String_map.keys setup.packages)) + let build_package pkg = Future.Scheduler.go ~log:(create_log ()) (Main.setup () >>= fun setup -> - match Main.package_install_file setup pkg with - | Ok path -> - Build_system.do_build_exn setup.build_system - [path] - | Error () -> - die "Unknown package %s!%s" pkg (hint pkg (String_map.keys setup.packages)) - ) + Build_system.do_build_exn setup.build_system + [resolve_package_install setup pkg]) let build_package = let doc = "build a package in release mode" in @@ -207,11 +208,7 @@ let runtest = set_common common; Future.Scheduler.go ~log:(create_log ()) (Main.setup () >>= fun setup -> - let dirs = - match dirs with - | [] -> [Path.root] - | _ -> List.map dirs ~f:Path.(relative root) - in + let dirs = List.map dirs ~f:Path.(relative root) in let targets = List.map dirs ~f:(fun dir -> let dir = @@ -225,15 +222,75 @@ let runtest = Build_system.do_build_exn setup.build_system targets) in ( Term.(const go $ common - $ Arg.(value & pos_all string [] name_)) + $ Arg.(value & pos_all string ["."] name_)) , Term.info "runtest" ~doc ~man:help_secs) +let opam_installer (setup : Main.setup) = + match Context.which setup.context "opam-installer" with + | None -> + die "\ +Sorry, you need the opam-installer tool to be able to install or +uninstall packages. + +I couldn't find the opam-installer binary :-(" + | Some fn -> fn + +let get_prefix (setup : Main.setup) ~from_command_line = + match from_command_line with + | Some p -> Future.return (Path.of_string p) + | None -> Context.install_prefix setup.context + +let install_uninstall ~what = + let doc = sprintf "%s packages" what in + let name_ = Arg.info [] ~docv:"PACKAGE" in + let go common prefix pkgs = + set_common common; + Future.Scheduler.go ~log:(create_log ()) + (Main.setup () >>= fun setup -> + let opam_installer = opam_installer setup in + let install_files, missing_install_files = + List.partition_map pkgs ~f:(fun pkg -> + let fn = resolve_package_install setup pkg in + if Path.exists fn then + Inl fn + else + Inr pkg) + in + if missing_install_files <> [] then begin + die "The .install files for these packages are missing:\n\ + %s\n\ + You need to run: jbuilder build %s" + (String.concat ~sep:"\n" + (List.map missing_install_files ~f:(sprintf "- %s"))) + (String.concat ~sep:" " (List.map pkgs ~f:(sprintf "%s.install"))) + end; + get_prefix setup ~from_command_line:prefix >>= fun prefix -> + Future.all_unit + (List.map install_files ~f:(fun path -> + Future.run (Path.to_string opam_installer) + [ sprintf "-%c" what.[0] + ; "--prefix" + ; Path.to_string prefix + ; Path.to_string path + ]))) + in + ( Term.(const go + $ common + $ Arg.(value & opt (some dir) None & info ["prefix"]) + $ Arg.(value & pos_all string [] name_)) + , Term.info what ~doc ~man:help_secs) + +let install = install_uninstall ~what:"install" +let uninstall = install_uninstall ~what:"uninstall" + let all = [ internal ; build_package ; external_lib_deps ; build_targets ~name:"build" ; runtest + ; install + ; uninstall ] let () = diff --git a/src/ansi_color.ml b/src/ansi_color.ml index b3defc92..609a9623 100644 --- a/src/ansi_color.ml +++ b/src/ansi_color.ml @@ -160,7 +160,10 @@ let setup_env_for_ocaml_colors = lazy( | exception Not_found -> "color=always,_" | s -> "color=always," ^ s in - Unix.putenv "OCAMLPARAM" value + Unix.putenv "OCAMLPARAM" value; + match Sys.getenv "OPAMCOLOR" with + | exception Not_found -> Unix.putenv "OPAMCOLOR" "always" + | _ -> () end ) diff --git a/src/context.ml b/src/context.ml index aafce7af..96f53812 100644 --- a/src/context.ml +++ b/src/context.ml @@ -21,6 +21,7 @@ type t = ; env : string array ; findlib_path : Path.t list ; arch_sixtyfour : bool + ; opam_var_cache : (string, string) Hashtbl.t ; version : string ; stdlib_dir : Path.t ; ccomp_type : string @@ -64,7 +65,25 @@ let get_arch_sixtyfour stdlib_dir = | ["#define"; "ARCH_SIXTYFOUR"] -> true | _ -> false) +let opam_config_var ~env ~cache var = + match Hashtbl.find cache var with + | Some _ as x -> return x + | None -> + match Bin.opam with + | None -> return None + | Some fn -> + Future.run_capture (Path.to_string fn) ~env ["config"; "var"; var] + >>| fun s -> + let s = String.trim s in + Hashtbl.add cache ~key:var ~data:s; + Some s + let create ~(kind : Kind.t) ~path ~env = + let opam_var_cache = Hashtbl.create 128 in + (match kind with + | Opam { root; _ } -> + Hashtbl.add opam_var_cache ~key:"root" ~data:root + | Default -> ()); let name = match kind with | Default -> "default" @@ -99,13 +118,10 @@ let create ~(kind : Kind.t) ~path ~env = let ocamlc_config_cmd = sprintf "%s -config" (Path.to_string ocamlc) in both (both - (match Bin.opam with - | None -> - return [] - | Some fn -> - Future.run_capture_line ~env (Path.to_string fn) - ["config"; "var"; "lib"] - >>| fun s -> [Path.absolute s]) + (opam_config_var ~env ~cache:opam_var_cache "lib" + >>| function + | None -> [] + | Some s -> [Path.absolute s]) (match which "ocamlfind" with | None -> return [] @@ -172,6 +188,8 @@ let create ~(kind : Kind.t) ~path ~env = ; findlib_path ; arch_sixtyfour = get_arch_sixtyfour stdlib_dir + ; opam_var_cache + ; stdlib_dir ; version = get "version" ; ccomp_type = get "ccomp_type" @@ -210,6 +228,8 @@ let create ~(kind : Kind.t) ~path ~env = all_known := String_map.add !all_known ~key:name ~data:t; return t +let opam_config_var t var = opam_config_var ~env:t.env ~cache:t.opam_var_cache var + let initial_env = lazy ( Lazy.force Ansi_color.setup_env_for_ocaml_colors; Unix.environment ()) @@ -269,3 +289,8 @@ let create_for_opam ?root ~switch () = create ~kind:(Opam { root; switch }) ~path ~env:(extend_env ~vars ~env) let which t s = Bin.which ~path:t.path s + +let install_prefix t = + opam_config_var t "prefix" >>| function + | Some x -> Path.absolute x + | None -> Path.parent t.ocaml_bin diff --git a/src/context.mli b/src/context.mli index 15dbb8b9..cc39c54b 100644 --- a/src/context.mli +++ b/src/context.mli @@ -56,6 +56,8 @@ type t = ; (** Misc *) arch_sixtyfour : bool + ; opam_var_cache : (string, string) Hashtbl.t + ; (** Output of [ocamlc -config] *) version : string ; stdlib_dir : Path.t @@ -100,3 +102,7 @@ val all : unit -> t String_map.t val which : t -> string -> Path.t option val extend_env : vars:string String_map.t -> env:string array -> string array + +val opam_config_var : t -> string -> string option Future.t + +val install_prefix : t -> Path.t Future.t diff --git a/src/import.ml b/src/import.ml index 075a31ee..74f6d542 100644 --- a/src/import.ml +++ b/src/import.ml @@ -68,6 +68,12 @@ module List = struct match l with | [] -> None | x :: l -> if f x then Some x else find l ~f + + let longest_map l ~f = + fold_left l ~init:0 ~f:(fun acc x -> + max acc (String.length (f x))) + + let longest l = longest_map l ~f:(fun x -> x) end module Hashtbl = struct diff --git a/src/jbuild_types.ml b/src/jbuild_types.ml index e5fd49ba..15806db5 100644 --- a/src/jbuild_types.ml +++ b/src/jbuild_types.ml @@ -817,10 +817,7 @@ module Stanza = struct in let known_packages () = let visible_packages = String_map.bindings visible_packages in - let longest_pkg = - List.fold_left visible_packages ~init:0 ~f:(fun acc (pkg, _) -> - max (String.length pkg) acc) - in + let longest_pkg = List.longest_map visible_packages ~f:fst in String.concat ~sep:"\n" (List.map visible_packages ~f:(fun (pkg, dir) -> sprintf "- %-*s (because of %s)" longest_pkg pkg diff --git a/src/path.ml b/src/path.ml index ee68f800..dd926972 100644 --- a/src/path.ml +++ b/src/path.ml @@ -69,14 +69,16 @@ module Local = struct loop t [] len len let parent = function - | "" -> assert false + | "" -> + code_errorf "Path.Local.parent called on the root" | t -> match String.rindex_from t (String.length t - 1) '/' with | exception Not_found -> "" | i -> String.sub t ~pos:0 ~len:i let basename = function - | "" -> assert false + | "" -> + code_errorf "Path.Local.basename called on the root" | t -> let len = String.length t in match String.rindex_from t (len - 1) '/' with @@ -174,6 +176,8 @@ let to_string = function | "" -> "." | t -> t +let sexp_of_t t = Sexp.Atom (to_string t) + let root = "" let relative t fn = @@ -198,7 +202,11 @@ let absolute = let reach t ~from = match is_local t, is_local from with | false, _ -> t - | true, false -> assert false + | true, false -> + Sexp.code_error "Path.reach called with invalid combination" + [ "t" , sexp_of_t t + ; "from", sexp_of_t from + ] | true, true -> Local.reach t ~from let descendant t ~of_ = diff --git a/src/sexp.ml b/src/sexp.ml index ee0c2897..9a831b00 100644 --- a/src/sexp.ml +++ b/src/sexp.ml @@ -61,6 +61,13 @@ let rec to_string = function | Atom s -> if must_escape s then sprintf "%S" s else s | List l -> sprintf "(%s)" (List.map l ~f:to_string |> String.concat ~sep:" ") +let code_error message vars = + code_errorf "%s" + (to_string + (List (Atom message + :: List.map vars ~f:(fun (name, value) -> + List [Atom name; value])))) + module type Combinators = sig type 'a t val unit : unit t diff --git a/src/sexp.mli b/src/sexp.mli index d809a21b..446410fe 100644 --- a/src/sexp.mli +++ b/src/sexp.mli @@ -9,6 +9,8 @@ exception Of_sexp_error of t * string val of_sexp_error : t -> string -> _ val of_sexp_errorf : t -> ('a, unit, string, 'b) format4 -> 'a +val code_error : string -> (string * t) list -> _ + module Locs : sig type t = | Atom of Loc.t