fix: redirect deprecated libraries resolution to the public lib DB (o…

…caml#10354) * fix: redirect deprecated libraries resolution to the public lib DB Signed-off-by: Antonio Nuno Monteiro <[email protected]> * add a new `Redirect_to_lib_id` constructor Signed-off-by: Antonio Nuno Monteiro <[email protected]> * refactor: rename Redirect_to_lib_id to Redirect_by_id, Redirect_by_name Signed-off-by: Antonio Nuno Monteiro <[email protected]> * refactor: in scope.ml, move helper functions to the lexical scope where they're used Signed-off-by: Antonio Nuno Monteiro <[email protected]> * revert visibility change Signed-off-by: Antonio Nuno Monteiro <[email protected]> * refactor: rename `parent` to `public_libs` Signed-off-by: Antonio Nuno Monteiro <[email protected]> --------- Signed-off-by: Antonio Nuno Monteiro <[email protected]>
anmonteiro · Apr 4, 2024 · c6a0a69 · c6a0a69
1 parent 547e55e
commit c6a0a69
Show file tree

Hide file tree

Showing 4 changed files with 230 additions and 220 deletions.
diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml
@@ -424,7 +424,8 @@ and resolve_result =
   | Invalid of User_message.t
   | Ignore
   | Redirect_in_the_same_db of (Loc.t * Lib_name.t)
-  | Redirect of db * Lib_id.t
+  | Redirect_by_name of db * (Loc.t * Lib_name.t)
+  | Redirect_by_id of db * Lib_id.t
 
 let lib_config (t : lib) = t.lib_config
 let name t = t.name
@@ -1153,7 +1154,8 @@ end = struct
   let handle_resolve_result db ~super = function
     | Ignore -> Memo.return Status.Ignore
     | Redirect_in_the_same_db (_, name') -> find_internal db name'
-    | Redirect (db', lib_id') -> resolve_lib_id db' lib_id'
+    | Redirect_by_name (db', (_, name')) -> find_internal db' name'
+    | Redirect_by_id (db', lib_id) -> resolve_lib_id db' lib_id
     | Found info ->
       let name = Lib_info.name info in
       instantiate db name info ~hidden:None
@@ -1173,7 +1175,8 @@ end = struct
       Memo.parallel_map candidates ~f:(function
         | Ignore -> Memo.return (Some Status.Ignore)
         | Redirect_in_the_same_db (_, name') -> find_internal db name' >>| Option.some
-        | Redirect (db', lib_id') -> resolve_lib_id db' lib_id' >>| Option.some
+        | Redirect_by_name (db', (_, name')) -> find_internal db' name' >>| Option.some
+        | Redirect_by_id (db', lib_id) -> resolve_lib_id db' lib_id >>| Option.some
         | Found info ->
           Lib_info.enabled info
           >>= (function
@@ -1866,11 +1869,13 @@ module DB = struct
       | Invalid of User_message.t
       | Ignore
       | Redirect_in_the_same_db of (Loc.t * Lib_name.t)
-      | Redirect of db * Lib_id.t
+      | Redirect_by_name of db * (Loc.t * Lib_name.t)
+      | Redirect_by_id of db * Lib_id.t
 
     let found f = Found f
     let not_found = Not_found
-    let redirect db lib = Redirect (db, lib)
+    let redirect_by_name db lib = Redirect_by_name (db, lib)
+    let redirect_by_id db lib_id = Redirect_by_id (db, lib_id)
     let redirect_in_the_same_db lib = Redirect_in_the_same_db lib
 
     let to_dyn x =
@@ -1881,7 +1886,9 @@ module DB = struct
       | Found lib -> variant "Found" [ Lib_info.to_dyn Path.to_dyn lib ]
       | Hidden h -> variant "Hidden" [ Hidden.to_dyn (Lib_info.to_dyn Path.to_dyn) h ]
       | Ignore -> variant "Ignore" []
-      | Redirect (_, lib_id) -> variant "Redirect" [ Lib_id.to_dyn lib_id ]
+      | Redirect_by_name (_, (_, name)) ->
+        variant "Redirect_by_name" [ Lib_name.to_dyn name ]
+      | Redirect_by_id (_, lib_id) -> variant "Redirect_by_id" [ Lib_id.to_dyn lib_id ]
       | Redirect_in_the_same_db (_, name) ->
         variant "Redirect_in_the_same_db" [ Lib_name.to_dyn name ]
     ;;

diff --git a/src/dune_rules/lib.mli b/src/dune_rules/lib.mli
@@ -100,7 +100,8 @@ module DB : sig
     val not_found : t
     val found : Lib_info.external_ -> t
     val to_dyn : t Dyn.builder
-    val redirect : db -> Lib_id.t -> t
+    val redirect_by_name : db -> Loc.t * Lib_name.t -> t
+    val redirect_by_id : db -> Lib_id.t -> t
     val redirect_in_the_same_db : Loc.t * Lib_name.t -> t
   end
 

diff --git a/src/dune_rules/lib_id.ml b/src/dune_rules/lib_id.ml
@@ -18,7 +18,7 @@ module Local = struct
       | x -> x
     ;;
 
-    let to_dyn { name; loc; enabled_if; src_dir } =
+    let to_dyn { name; loc; enabled_if; src_dir; _ } =
       let open Dyn in
       record
         [ "name", Lib_name.to_dyn name