Avoid loading findlib packages more than once
This commit is contained in:
parent
35d987e4f0
commit
24ac055511
|
@ -16,6 +16,7 @@
|
||||||
+ =runtest=
|
+ =runtest=
|
||||||
+ =install=
|
+ =install=
|
||||||
+ =uninstall=
|
+ =uninstall=
|
||||||
|
+ =installed-libraries=
|
||||||
|
|
||||||
- Added support for aliases
|
- Added support for aliases
|
||||||
(#7, Rudi Grinberg)
|
(#7, Rudi Grinberg)
|
||||||
|
|
65
bin/main.ml
65
bin/main.ml
|
@ -12,36 +12,6 @@ let (>>=) = Future.(>>=)
|
||||||
|
|
||||||
let create_log = Main.create_log
|
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 =
|
type common =
|
||||||
{ concurrency: int
|
{ concurrency: int
|
||||||
; debug_rules: bool
|
; debug_rules: bool
|
||||||
|
@ -85,6 +55,29 @@ let common =
|
||||||
let dev = Arg.(value & flag & info ["dev"] ~docs) in
|
let dev = Arg.(value & flag & info ["dev"] ~docs) in
|
||||||
Term.(const make $ concurrency $ drules $ ddep_path $ dfindlib $ dev)
|
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 =
|
let resolve_package_install setup pkg =
|
||||||
match Main.package_install_file setup pkg with
|
match Main.package_install_file setup pkg with
|
||||||
| Ok path -> path
|
| Ok path -> path
|
||||||
|
@ -98,7 +91,7 @@ let build_package pkg =
|
||||||
[resolve_package_install setup pkg])
|
[resolve_package_install setup pkg])
|
||||||
|
|
||||||
let build_package =
|
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 name_ = Arg.info [] ~docv:"PACKAGE-NAME" in
|
||||||
let go common pkg =
|
let go common pkg =
|
||||||
set_common common;
|
set_common common;
|
||||||
|
@ -121,7 +114,7 @@ let external_lib_deps packages =
|
||||||
| Optional -> Printf.printf "%s (optional)\n" n)
|
| Optional -> Printf.printf "%s (optional)\n" n)
|
||||||
|
|
||||||
let external_lib_deps =
|
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 name_ = Arg.info [] ~docv:"PACKAGE-NAME" in
|
||||||
let go common packages =
|
let go common packages =
|
||||||
set_common common;
|
set_common common;
|
||||||
|
@ -188,7 +181,7 @@ let resolve_targets (setup : Main.setup) user_targets =
|
||||||
| Alias (_, alias) -> Alias.file alias)
|
| Alias (_, alias) -> Alias.file alias)
|
||||||
|
|
||||||
let build_targets =
|
let build_targets =
|
||||||
let doc = "build targets" in
|
let doc = "Build targets." in
|
||||||
let name_ = Arg.info [] ~docv:"TARGET" in
|
let name_ = Arg.info [] ~docv:"TARGET" in
|
||||||
let go common targets =
|
let go common targets =
|
||||||
set_common common;
|
set_common common;
|
||||||
|
@ -202,7 +195,7 @@ let build_targets =
|
||||||
, Term.info "build" ~doc ~man:help_secs)
|
, Term.info "build" ~doc ~man:help_secs)
|
||||||
|
|
||||||
let runtest =
|
let runtest =
|
||||||
let doc = "run tests" in
|
let doc = "Run tests." in
|
||||||
let name_ = Arg.info [] ~docv:"DIR" in
|
let name_ = Arg.info [] ~docv:"DIR" in
|
||||||
let go common dirs =
|
let go common dirs =
|
||||||
set_common common;
|
set_common common;
|
||||||
|
@ -241,7 +234,7 @@ let get_prefix (setup : Main.setup) ~from_command_line =
|
||||||
| None -> Context.install_prefix setup.context
|
| None -> Context.install_prefix setup.context
|
||||||
|
|
||||||
let install_uninstall ~what =
|
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 name_ = Arg.info [] ~docv:"PACKAGE" in
|
||||||
let go common prefix pkgs =
|
let go common prefix pkgs =
|
||||||
set_common common;
|
set_common common;
|
||||||
|
@ -284,7 +277,7 @@ let install = install_uninstall ~what:"install"
|
||||||
let uninstall = install_uninstall ~what:"uninstall"
|
let uninstall = install_uninstall ~what:"uninstall"
|
||||||
|
|
||||||
let all =
|
let all =
|
||||||
[ internal
|
[ installed_libraries
|
||||||
; build_package
|
; build_package
|
||||||
; external_lib_deps
|
; external_lib_deps
|
||||||
; build_targets
|
; build_targets
|
||||||
|
|
|
@ -144,7 +144,12 @@ let has_headers t ~dir =
|
||||||
match Hashtbl.find t.has_headers dir with
|
match Hashtbl.find t.has_headers dir with
|
||||||
| Some x -> x
|
| Some x -> x
|
||||||
| None ->
|
| 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;
|
Hashtbl.add t.has_headers ~key:dir ~data:x;
|
||||||
x
|
x
|
||||||
|
|
||||||
|
@ -227,7 +232,8 @@ let root_package_name s =
|
||||||
| Some i -> String.sub s ~pos:0 ~len:i
|
| Some i -> String.sub s ~pos:0 ~len:i
|
||||||
|
|
||||||
let rec load_meta_rec t root_name ~packages =
|
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
|
packages
|
||||||
else
|
else
|
||||||
let rec loop dirs : Path.t * Meta.t =
|
let rec loop dirs : Path.t * Meta.t =
|
||||||
|
@ -419,8 +425,8 @@ let root_packages t =
|
||||||
let all_packages t =
|
let all_packages t =
|
||||||
List.iter (root_packages t) ~f:(fun pkg ->
|
List.iter (root_packages t) ~f:(fun pkg ->
|
||||||
ignore (find_exn t pkg : package));
|
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
|
match data with
|
||||||
| Present _ -> pkg :: acc
|
| Present p -> p :: acc
|
||||||
| Absent -> 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 context : t -> Context.t
|
||||||
|
|
||||||
val root_packages : t -> string list
|
|
||||||
val all_packages : t -> string list
|
|
||||||
|
|
||||||
type package =
|
type package =
|
||||||
{ name : string
|
{ name : string
|
||||||
; dir : Path.t
|
; dir : Path.t
|
||||||
|
@ -32,3 +29,6 @@ val root_package_name : string -> string
|
||||||
|
|
||||||
val closure : package list -> package list
|
val closure : package list -> package list
|
||||||
val closed_ppx_runtime_deps_of : 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