feature: revive external-lib-deps

Determining the missing library dependencies is revived under $ dune
describe external-lib-deps.

Signed-off-by: Alpha DIALLO <[email protected]>

CHANGES.md

@@ -1,6 +1,9 @@
 Unreleased
 ----------
 
+- Revive `$ dune external-lib-deps` under `$ dune describe external-lib-deps`.
+  (#6045, @moyodiallo)
+
 - Fix running inline tests in byteode mode (#5622, fixes #5515, @dariusf)
 
 - [ctypes] always re-run `pkg-config` because we aren't tracking its external

bin/describe.ml

@@ -296,7 +296,7 @@ module Crawl = struct
       Option.map (Module.source m ~ml_kind) ~f:Module.File.path
     in
     let cmt ml_kind =
-      Obj_dir.Module.cmt_file obj_dir m ~ml_kind ~cm_kind:(Ocaml Cmi)
+      Dune_rules.Obj_dir.Module.cmt_file obj_dir m ~ml_kind ~cm_kind:(Ocaml Cmi)
     in
     { Descr.Mod.name = Module.name m
     ; impl = source Impl
@@ -582,6 +582,167 @@ module Opam_files = struct
            Dyn.Tuple [ String (Path.to_string opam_file); String contents ]))
 end
 
+module External_lib_deps = struct
+  include struct
+    open Dune_rules
+    module Lib_dep = Lib_dep
+    module Preprocess = Preprocess
+    module Lib = Lib
+    module Lib_info = Lib_info
+    module Scope = Scope
+    module Dune_file = Dune_file
+  end
+
+  module Kind = struct
+    type t =
+      | Required
+      | Optional
+
+    let to_dyn : t -> Dyn.t = function
+      | Required -> String "required"
+      | Optional -> String "optional"
+
+    let merge x y =
+      match (x, y) with
+      | Optional, Optional -> Optional
+      | _ -> Required
+  end
+
+  type external_lib_dep =
+    { name : Lib_name.t
+    ; kind : Kind.t
+    }
+
+  type lib_deps =
+    { dir : Path.Source.t
+    ; deps : Lib_dep.t list
+    ; pps : Preprocess.With_instrumentation.t Preprocess.Per_module.t
+    }
+
+  let is_external db name =
+    let open Memo.O in
+    let+ lib = Lib.DB.find_even_when_hidden db name in
+    match lib with
+    | None -> true
+    | Some t -> (
+      match Lib_info.status (Lib.info t) with
+      | Installed_private | Public _ | Private _ -> false
+      | Installed -> true)
+
+  let libs (context : Context.t) (build_system : Dune_rules.Main.build_system) =
+    let { Dune_rules.Main.conf; contexts = _; _ } = build_system in
+    let open Memo.O in
+    let+ dune_files =
+      Dune_rules.Dune_load.Dune_files.eval conf.dune_files ~context
+    in
+    List.concat_map dune_files ~f:(fun (dune_file : Dune_file.t) ->
+        List.concat_map dune_file.stanzas ~f:(fun stanza ->
+            let dir = dune_file.dir in
+            match stanza with
+            | Dune_file.Executables exes ->
+              [ { deps = exes.buildable.libraries
+                ; dir
+                ; pps = exes.buildable.preprocess
+                }
+              ]
+            | Dune_file.Library lib ->
+              [ { deps = lib.buildable.libraries
+                ; dir
+                ; pps = lib.buildable.preprocess
+                }
+              ]
+            | _ -> []))
+
+  let external_lib_pps db preprocess =
+    let open Memo.O in
+    let* pps =
+      Resolve.Memo.read_memo
+        (Preprocess.Per_module.with_instrumentation preprocess
+           ~instrumentation_backend:(Lib.DB.instrumentation_backend db))
+      >>| Preprocess.Per_module.pps
+    in
+    Memo.parallel_map
+      ~f:(fun (_, name) ->
+        let+ is_external = is_external db name in
+        if is_external then Some { name; kind = Kind.Required } else None)
+      pps
+    >>| List.filter_opt
+
+  let external_resolve db name kind =
+    let open Memo.O in
+    let+ is_external = is_external db name in
+    if is_external then Some { name; kind } else None
+
+  let external_lib_deps db lib_deps =
+    Memo.parallel_map lib_deps ~f:(fun { deps; dir; pps } ->
+        let open Memo.O in
+        let* libs =
+          deps
+          |> Memo.parallel_map ~f:(fun lib ->
+                 match lib with
+                 | Lib_dep.Direct (_, name) | Lib_dep.Re_export (_, name) -> (
+                   let+ v = external_resolve db name Kind.Required in
+                   match v with
+                   | Some x -> [ x ]
+                   | None -> [])
+                 | Lib_dep.Select select ->
+                   select.choices
+                   |> Memo.parallel_map
+                        ~f:(fun (choice : Lib_dep.Select.Choice.t) ->
+                          Lib_name.Set.to_string_list choice.required
+                          @ Lib_name.Set.to_string_list choice.forbidden
+                          |> Memo.parallel_map ~f:(fun name ->
+                                 let name = Lib_name.of_string name in
+                                 external_resolve db name Kind.Optional)
+                          >>| List.filter_map ~f:(fun x -> x))
+                   >>| List.concat)
+          >>| List.concat
+        in
+        let+ pps = external_lib_pps db pps in
+        (dir, libs @ pps))
+
+  let libs_to_lib_map libs =
+    List.fold_left ~init:Lib_name.Map.empty libs ~f:(fun acc_map lib ->
+        Lib_name.Map.update acc_map lib.name ~f:(fun n ->
+            match n with
+            | Some k -> Some (Kind.merge k lib.kind)
+            | None -> Some lib.kind))
+
+  let libs_dir_to_map libs_dir =
+    List.fold_left ~init:Path.Source.Map.empty libs_dir
+      ~f:(fun acc_map (dir, libs) ->
+        match Path.Source.Map.find acc_map dir with
+        | None -> Path.Source.Map.add_exn acc_map dir (libs_to_lib_map libs)
+        | Some libs_map ->
+          Path.Source.Map.set acc_map dir
+            (Lib_name.Map.union libs_map (libs_to_lib_map libs)
+               ~f:(fun _ k1 k2 -> Some (Kind.merge k1 k2))))
+
+  let external_resolved_libs setup super_context =
+    let open Memo.O in
+    let context = Super_context.context super_context in
+    let* public_libs = Scope.DB.public_libs context in
+    let* libs = libs context setup in
+    external_lib_deps public_libs libs
+
+  let to_dyn context_name external_resolved_libs =
+    Dyn.Tuple
+      [ Dyn.String context_name
+      ; external_resolved_libs |> libs_dir_to_map
+        |> Path.Source.Map.filter ~f:(fun m -> not (Lib_name.Map.is_empty m))
+        |> Path.Source.Map.to_dyn (fun libs ->
+               Lib_name.Map.to_dyn Kind.to_dyn libs)
+      ]
+
+  let get setup super_context =
+    let open Memo.O in
+    let context_name =
+      Super_context.context super_context
+      |> Context.name |> Dune_engine.Context_name.to_string
+    in
+    external_resolved_libs setup super_context >>| to_dyn context_name
+end
+
 module Preprocess = struct
   let pp_with_ocamlc sctx project pp_file =
     let open Dune_engine in
@@ -666,6 +827,7 @@ end
 module What = struct
   type t =
     | Workspace of { dirs : string list option }
+    | External_lib_deps
     | Opam_files
     | Pp of string
 
@@ -699,6 +861,11 @@ module What = struct
       , "builds a given FILE and prints the preprocessed output"
       , let+ s = filename in
         Pp s )
+    ; ( "external-lib-deps"
+      , []
+      , "Print out external libraries needed to build the project. It's an \
+         approximated set of libraries."
+      , return External_lib_deps )
     ]
 
   (* The list of documentation strings (one for each command) *)
@@ -736,6 +903,7 @@ module What = struct
     let some = Memo.map ~f:(fun x -> Some x) in
     match t with
     | Opam_files -> Opam_files.get () |> some
+    | External_lib_deps -> External_lib_deps.get setup super_context |> some
     | Workspace { dirs } ->
       let context = Super_context.context super_context in
       let open Memo.O in

test/blackbox-tests/test-cases/external-lib-deps/simple-pps.t/dune

@@ -0,0 +1,18 @@
+(library
+ (name foo)
+ (modules :standard \ prog)
+ (libraries a________ b________ c________)
+ (preprocess (pps d________ e________ f________)))
+
+(rule
+ (with-stdout-to file.ml
+  (echo %{lib-available:optional})))
+
+(rule (with-stdout-to foo.ml (run prog)))
+
+(executable
+ (name prog)
+ (modules prog)
+ (libraries h________ i________ j________))
+
+(rule (with-stdout-to prog.ml (echo "")))

test/blackbox-tests/test-cases/external-lib-deps/simple-pps.t/dune-project

@@ -0,0 +1,4 @@
+(lang dune 1.9)
+(name foo)
+
+(allow_approximate_merlin true)

test/blackbox-tests/test-cases/external-lib-deps/simple-pps.t/run.t

@@ -0,0 +1,14 @@
+Expected: To get all required and pps packages
+
+  $ dune describe external-lib-deps
+  (default
+   ((.
+     ((a________ required)
+      (b________ required)
+      (c________ required)
+      (d________ required)
+      (e________ required)
+      (f________ required)
+      (h________ required)
+      (i________ required)
+      (j________ required)))))

test/blackbox-tests/test-cases/external-lib-deps/simple.t/run.t

@@ -0,0 +1,11 @@
+external library dependencies of a simple project
+
+  $ echo "(lang dune 2.3)" > dune-project
+  $ touch dummypkg.opam
+  $ cat >dune <<EOF
+  > (library
+  >  (public_name dummypkg)
+  >  (libraries base doesnotexist.foo))
+  > EOF
+  $ dune describe external-lib-deps
+  (default ((. ((base required) (doesnotexist.foo required)))))