From b2a9d6dc518a3f739ebc60963b0b696da9c72069 Mon Sep 17 00:00:00 2001
From: Jeremie Dimino <jdimino@janestreet.com>
Date: Wed, 17 May 2017 14:54:50 +0100
Subject: [PATCH] Add: jbuilder installed-libraries --not-available

---
 bin/main.ml     | 39 +++++++++++++++++++++++++++------------
 src/findlib.ml  | 29 ++++++++++++++++++++++++++++-
 src/findlib.mli |  4 ++++
 src/main.ml     | 11 ++---------
 4 files changed, 61 insertions(+), 22 deletions(-)

diff --git a/bin/main.ml b/bin/main.ml
index aa37b470..533f22bf 100644
--- a/bin/main.ml
+++ b/bin/main.ml
@@ -256,24 +256,39 @@ let common =
 
 let installed_libraries =
   let doc = "Print out libraries installed on the system." in
-  let go common =
+  let go common na =
     set_common common;
     Future.Scheduler.go ~log:(Log.create ())
       (Context.default () >>= fun ctx ->
        let findlib = ctx.findlib 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 ())
+       if na then begin
+         let pkgs = Findlib.all_unavailable_packages findlib in
+         let longest = List.longest_map pkgs ~f:(fun na -> na.package) in
+         let ppf = Format.std_formatter in
+         List.iter pkgs ~f:(fun (na : Findlib.Package_not_available.t) ->
+           Format.fprintf ppf "%-*s -> %a@\n" longest na.package
+             Findlib.Package_not_available.explain na.reason);
+         Format.pp_print_flush ppf ();
+         Future.return ()
+       end else begin
+         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 ()
+       end)
   in
   ( Term.(const go
-          $ common)
+          $ common
+          $ Arg.(value
+                 & flag
+                 & info ["na"; "not-available"]
+                     ~doc:"List libraries that are not available and explain why"))
   , Term.info "installed-libraries" ~doc
   )
 
diff --git a/src/findlib.ml b/src/findlib.ml
index 22dbc828..140b1a66 100644
--- a/src/findlib.ml
+++ b/src/findlib.ml
@@ -177,6 +177,23 @@ module Package_not_available = struct
         (all_names ts
          |> List.map ~f:(sprintf "- %s")
          |> String.concat ~sep:"\n")
+
+  let explain ppf reason =
+    match reason with
+    | Not_found ->
+      Format.fprintf ppf "not found"
+    | Hidden ->
+      Format.fprintf ppf "hidden (unsatisfied 'exist_if')"
+    | Dependencies_unavailable deps ->
+      Format.fprintf ppf
+        "@[<2>unavailable dependencies:@ %t@]"
+        (fun ppf ->
+           match deps with
+           | [] -> ()
+           | t :: rest ->
+             Format.fprintf ppf "%s" t.package;
+             List.iter rest ~f:(fun t ->
+               Format.fprintf ppf ",@ %s" t.package))
 end
 
 type present_or_not_available =
@@ -532,10 +549,20 @@ let all_packages t =
     ignore (find t pkg ~required_by:[] : package option));
   Hashtbl.fold t.packages ~init:[] ~f:(fun ~key:_ ~data acc ->
     match data with
-    | Present p -> p :: acc
+    | Present       p -> p :: acc
     | Not_available _ -> acc)
   |> List.sort ~cmp:(fun a b -> String.compare a.name b.name)
 
+let all_unavailable_packages t =
+  List.iter (root_packages t) ~f:(fun pkg ->
+    ignore (find t pkg ~required_by:[] : package option));
+  Hashtbl.fold t.packages ~init:[] ~f:(fun ~key:_ ~data acc ->
+    match data with
+    | Present       _ -> acc
+    | Not_available n -> n :: acc)
+  |> List.sort ~cmp:(fun a b ->
+    String.compare a.Package_not_available.package b.package)
+
 let stdlib_with_archives t =
   let x = find_exn t ~required_by:[] "stdlib" in
   let archives =
diff --git a/src/findlib.mli b/src/findlib.mli
index 316c9708..996015f3 100644
--- a/src/findlib.mli
+++ b/src/findlib.mli
@@ -17,6 +17,9 @@ module Package_not_available : sig
     (** At least one dependency is unavailable *)
 
   val top_closure : t list -> t list
+
+  (** Explain why a package is not available *)
+  val explain : Format.formatter -> reason -> unit
 end
 
 exception Package_not_available of Package_not_available.t
@@ -77,5 +80,6 @@ val closed_ppx_runtime_deps_of
 
 val root_packages : t -> string list
 val all_packages  : t -> package list
+val all_unavailable_packages : t -> Package_not_available.t list
 
 val stdlib_with_archives : t -> package
diff --git a/src/main.ml b/src/main.ml
index 639e9915..5fe42735 100644
--- a/src/main.ml
+++ b/src/main.ml
@@ -108,15 +108,8 @@ let report_error ?(map_fname=fun x->x) ppf exn ~backtrace =
       let deps = Findlib.Package_not_available.top_closure deps in
       let longest = List.longest_map deps ~f:(fun na -> na.package) in
       List.iter deps ~f:(fun (na : Findlib.Package_not_available.t) ->
-        match na.reason with
-        | Not_found ->
-          Format.fprintf ppf "- %-*s -> not found\n" longest na.package
-        | Hidden ->
-          Format.fprintf ppf "- %-*s -> hidden (unsatisfied 'exist_if')\n"
-            longest na.package
-        | Dependencies_unavailable _ ->
-          Format.fprintf ppf "- %s%-*s -> unavailable dependencies\n"
-            na.package longest "")
+        Format.fprintf ppf "- %-*s -> %a@\n" longest na.package
+          Findlib.Package_not_available.explain na.reason)
     end;
     let cmdline_suggestion =
       (* CR-someday jdimino: this is ugly *)