Avoid loading findlib packages more than once
This commit is contained in:
parent
35d987e4f0
commit
24ac055511
|
@ -16,6 +16,7 @@
|
|||
+ =runtest=
|
||||
+ =install=
|
||||
+ =uninstall=
|
||||
+ =installed-libraries=
|
||||
|
||||
- Added support for aliases
|
||||
(#7, Rudi Grinberg)
|
||||
|
|
65
bin/main.ml
65
bin/main.ml
|
@ -12,36 +12,6 @@ let (>>=) = Future.(>>=)
|
|||
|
||||
let create_log = Main.create_log
|
||||
|
||||
(* TODO: rewrite this when command trees are supported.
|
||||
|
||||
https://github.com/dbuenzli/cmdliner/issues/24 *)
|
||||
let internal = function
|
||||
| [_; "findlib-packages"] ->
|
||||
Future.Scheduler.go ~log:(create_log ())
|
||||
(Lazy.force Context.default >>= fun ctx ->
|
||||
let findlib = Findlib.create ctx in
|
||||
let pkgs = Findlib.all_packages findlib in
|
||||
let max_len =
|
||||
List.map pkgs ~f:String.length
|
||||
|> List.fold_left ~init:0 ~f:max
|
||||
in
|
||||
List.iter pkgs ~f:(fun pkg ->
|
||||
let ver =
|
||||
match (Findlib.find_exn findlib pkg).version with
|
||||
| "" -> "n/a"
|
||||
| v -> v
|
||||
in
|
||||
Printf.printf "%-*s (version: %s)\n" max_len pkg ver);
|
||||
Future.return ())
|
||||
| _ ->
|
||||
()
|
||||
|
||||
let internal =
|
||||
let doc = "internal use only" in
|
||||
let name_ = Arg.info [] in
|
||||
( Term.(const internal $ Arg.(non_empty & pos_all string [] name_))
|
||||
, Term.info "internal" ~doc)
|
||||
|
||||
type common =
|
||||
{ concurrency: int
|
||||
; debug_rules: bool
|
||||
|
@ -85,6 +55,29 @@ let common =
|
|||
let dev = Arg.(value & flag & info ["dev"] ~docs) in
|
||||
Term.(const make $ concurrency $ drules $ ddep_path $ dfindlib $ dev)
|
||||
|
||||
let installed_libraries =
|
||||
let doc = "Print out libraries installed on the system." in
|
||||
let go common =
|
||||
set_common common;
|
||||
Future.Scheduler.go ~log:(create_log ())
|
||||
(Lazy.force Context.default >>= fun ctx ->
|
||||
let findlib = Findlib.create ctx in
|
||||
let pkgs = Findlib.all_packages findlib in
|
||||
let max_len = List.longest_map pkgs ~f:(fun p -> p.name) in
|
||||
List.iter pkgs ~f:(fun pkg ->
|
||||
let ver =
|
||||
match pkg.Findlib.version with
|
||||
| "" -> "n/a"
|
||||
| v -> v
|
||||
in
|
||||
Printf.printf "%-*s (version: %s)\n" max_len pkg.name ver);
|
||||
Future.return ())
|
||||
in
|
||||
( Term.(const go
|
||||
$ common)
|
||||
, Term.info "installed-libraries" ~doc
|
||||
)
|
||||
|
||||
let resolve_package_install setup pkg =
|
||||
match Main.package_install_file setup pkg with
|
||||
| Ok path -> path
|
||||
|
@ -98,7 +91,7 @@ let build_package pkg =
|
|||
[resolve_package_install setup pkg])
|
||||
|
||||
let build_package =
|
||||
let doc = "build a package in release mode" in
|
||||
let doc = "Build a single package in release mode." in
|
||||
let name_ = Arg.info [] ~docv:"PACKAGE-NAME" in
|
||||
let go common pkg =
|
||||
set_common common;
|
||||
|
@ -121,7 +114,7 @@ let external_lib_deps packages =
|
|||
| Optional -> Printf.printf "%s (optional)\n" n)
|
||||
|
||||
let external_lib_deps =
|
||||
let doc = "print out external library dependencies" in
|
||||
let doc = "Print out external library dependencies." in
|
||||
let name_ = Arg.info [] ~docv:"PACKAGE-NAME" in
|
||||
let go common packages =
|
||||
set_common common;
|
||||
|
@ -188,7 +181,7 @@ let resolve_targets (setup : Main.setup) user_targets =
|
|||
| Alias (_, alias) -> Alias.file alias)
|
||||
|
||||
let build_targets =
|
||||
let doc = "build targets" in
|
||||
let doc = "Build targets." in
|
||||
let name_ = Arg.info [] ~docv:"TARGET" in
|
||||
let go common targets =
|
||||
set_common common;
|
||||
|
@ -202,7 +195,7 @@ let build_targets =
|
|||
, Term.info "build" ~doc ~man:help_secs)
|
||||
|
||||
let runtest =
|
||||
let doc = "run tests" in
|
||||
let doc = "Run tests." in
|
||||
let name_ = Arg.info [] ~docv:"DIR" in
|
||||
let go common dirs =
|
||||
set_common common;
|
||||
|
@ -241,7 +234,7 @@ let get_prefix (setup : Main.setup) ~from_command_line =
|
|||
| None -> Context.install_prefix setup.context
|
||||
|
||||
let install_uninstall ~what =
|
||||
let doc = sprintf "%s packages" what in
|
||||
let doc = sprintf "%s packages using opam-installer." (String.capitalize what) in
|
||||
let name_ = Arg.info [] ~docv:"PACKAGE" in
|
||||
let go common prefix pkgs =
|
||||
set_common common;
|
||||
|
@ -284,7 +277,7 @@ let install = install_uninstall ~what:"install"
|
|||
let uninstall = install_uninstall ~what:"uninstall"
|
||||
|
||||
let all =
|
||||
[ internal
|
||||
[ installed_libraries
|
||||
; build_package
|
||||
; external_lib_deps
|
||||
; build_targets
|
||||
|
|
|
@ -144,7 +144,12 @@ let has_headers t ~dir =
|
|||
match Hashtbl.find t.has_headers dir with
|
||||
| Some x -> x
|
||||
| None ->
|
||||
let x = List.exists (Path.readdir dir) ~f:(fun fn -> Filename.check_suffix fn ".h") in
|
||||
let x =
|
||||
match Path.readdir dir with
|
||||
| exception _ -> false
|
||||
| files ->
|
||||
List.exists files ~f:(fun fn -> Filename.check_suffix fn ".h")
|
||||
in
|
||||
Hashtbl.add t.has_headers ~key:dir ~data:x;
|
||||
x
|
||||
|
||||
|
@ -227,7 +232,8 @@ let root_package_name s =
|
|||
| Some i -> String.sub s ~pos:0 ~len:i
|
||||
|
||||
let rec load_meta_rec t root_name ~packages =
|
||||
if String_map.mem root_name packages then
|
||||
if String_map.mem root_name packages ||
|
||||
Hashtbl.mem t.packages root_name then
|
||||
packages
|
||||
else
|
||||
let rec loop dirs : Path.t * Meta.t =
|
||||
|
@ -419,8 +425,8 @@ let root_packages t =
|
|||
let all_packages t =
|
||||
List.iter (root_packages t) ~f:(fun pkg ->
|
||||
ignore (find_exn t pkg : package));
|
||||
Hashtbl.fold t.packages ~init:[] ~f:(fun ~key:pkg ~data acc ->
|
||||
Hashtbl.fold t.packages ~init:[] ~f:(fun ~key:_ ~data acc ->
|
||||
match data with
|
||||
| Present _ -> pkg :: acc
|
||||
| Present p -> p :: acc
|
||||
| Absent -> acc)
|
||||
|> List.sort ~cmp:String.compare
|
||||
|> List.sort ~cmp:(fun a b -> String.compare a.name b.name)
|
||||
|
|
|
@ -9,9 +9,6 @@ val create : Context.t -> t
|
|||
|
||||
val context : t -> Context.t
|
||||
|
||||
val root_packages : t -> string list
|
||||
val all_packages : t -> string list
|
||||
|
||||
type package =
|
||||
{ name : string
|
||||
; dir : Path.t
|
||||
|
@ -32,3 +29,6 @@ val root_package_name : string -> string
|
|||
|
||||
val closure : package list -> package list
|
||||
val closed_ppx_runtime_deps_of : package list -> package list
|
||||
|
||||
val root_packages : t -> string list
|
||||
val all_packages : t -> package list
|
||||
|
|
Loading…
Reference in New Issue