added install/uninstall commands
This commit is contained in:
parent
a3346384c4
commit
437a4fa5d7
|
@ -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)
|
||||
|
|
83
bin/main.ml
83
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 <package>.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 () =
|
||||
|
|
|
@ -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
|
||||
)
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
14
src/path.ml
14
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_ =
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue