Merge pull request tarides#371 from Leonidas-from-XIV/rewrite-all-dun…

…e-files

Process all `dune` files in the project when applying renames

CHANGES.md

@@ -22,6 +22,9 @@
 
 ### Fixed
 
+- Process all `dune` in the project after renaming libraries to avoid pointing
+  to non-existing vendored libraries (#370, #371 @Leonidas-from-XIV)
+
 ### Removed
 
 ### Security

lib/dune_file.ml

@@ -134,10 +134,13 @@ module Packages = struct
 
             let stanzas, renames =
               match name with
-              | Some name ->
-                  let renames = Map.add ~key:public_name ~data:name renames in
+              | Some _private_name ->
+                  let renames =
+                    Map.add ~key:public_name ~data:new_public_name renames
+                  in
                   (stanzas, renames)
               | None ->
+                  (* we need to add a valid "name" field if there is none *)
                   let new_name = random_library_name t public_name in
                   let stanzas =
                     List [ Atom "name"; Atom new_name ] :: stanzas
@@ -157,23 +160,55 @@ module Packages = struct
         { changed; stanzas = List (Atom "library" :: stanzas); renames }
     | stanzas -> { changed = false; stanzas; renames }
 
-  let translate_lib renames = function
+  let update_lib_reference renames = function
     | Atom old_name as original -> (
         match Map.find_opt old_name renames with
-        | Some new_name -> Atom new_name
-        | None -> original)
-    | otherwise -> otherwise
+        | Some new_name ->
+            let stanzas = Atom new_name in
+            { changed = true; stanzas; renames }
+        | None -> { changed = false; stanzas = original; renames })
+    | otherwise -> { changed = false; stanzas = otherwise; renames }
 
-  let rec translate renames = function
-    | Atom _ as original -> original
+  let rec update_reference renames = function
+    | Atom _ as original -> { changed = false; stanzas = original; renames }
     | List ((Atom "libraries" as stanza) :: libs) ->
-        let libs = List.map ~f:(translate_lib renames) libs in
-        List (stanza :: libs)
+        let changed, libs =
+          List.fold_left
+            ~f:(fun (changed_before, acc) lib ->
+              let { changed; stanzas; renames = _ } =
+                update_lib_reference renames lib
+              in
+              (changed_before || changed, stanzas :: acc))
+            ~init:(false, []) libs
+        in
+        let libs = List.rev libs in
+        let stanzas = List (stanza :: libs) in
+        { changed; stanzas; renames }
     | List sexps ->
-        let sexps = List.map ~f:(translate renames) sexps in
-        List sexps
+        let changed, sexps =
+          List.fold_left
+            ~f:(fun (changed_before, acc) sexp ->
+              let { changed; stanzas; renames = _ } =
+                update_reference renames sexp
+              in
+              (changed_before || changed, stanzas :: acc))
+            ~init:(false, []) sexps
+        in
+        let sexps = List.rev sexps in
+        { changed; stanzas = List sexps; renames }
 
-  let update_references renames = List.map ~f:(translate renames)
+  let update_references renames sexps =
+    let changed, sexps =
+      List.fold_left
+        ~f:(fun (changed_before, acc) sexp ->
+          let { changed; stanzas; renames = _ } =
+            update_reference renames sexp
+          in
+          (changed_before || changed, stanzas :: acc))
+        ~init:(false, []) sexps
+    in
+    let sexps = List.rev sexps in
+    { changed; stanzas = sexps; renames }
 
   let rename t ~keep renames sexps =
     let keep = Set.of_list keep in

lib/dune_file.mli

@@ -50,7 +50,7 @@ module Packages : sig
     Sexplib0.Sexp.t list rename_result
 
   val update_references :
-    string Map.t -> Sexplib0.Sexp.t list -> Sexplib0.Sexp.t list
+    string Map.t -> Sexplib0.Sexp.t list -> Sexplib0.Sexp.t list rename_result
 end
 
 module Project : sig

lib/pull.ml

@@ -51,6 +51,18 @@ let rec pp_sexp ppf = function
           let s = String.escaped s in
           Fmt.pf ppf {|"%s"|} s)
 
+let write_sexps path sexps =
+  let open Result.O in
+  let* write_result =
+    Bos.OS.File.with_oc path
+      (fun oc sexps ->
+        let ppf = Format.formatter_of_out_channel oc in
+        List.iter ~f:(fun sexp -> Fmt.pf ppf "%a\n" pp_sexp sexp) sexps;
+        Ok ())
+      sexps
+  in
+  write_result
+
 let postprocess_project ~keep ~disambiguation directory =
   let open Result.O in
   let is_dune_file path =
@@ -60,33 +72,53 @@ let postprocess_project ~keep ~disambiguation directory =
   let elements = `Sat is_dune_file in
   let dfp = Dune_file.Packages.init disambiguation in
   let renames = Dune_file.Packages.Map.empty in
-  (* determine files and their mappings first *)
-  let* files, renames =
+  (* determine mappings first *)
+  let* renames =
     Bos.OS.Path.fold ~elements
-      (fun path (acc, renames) ->
+      (fun path renames ->
         match preprocess_dune dfp ~keep ~renames path with
-        | Ok (Some (sexps, renames)) ->
-            let v = (path, sexps) in
-            (v :: acc, renames)
-        | Ok None -> (acc, renames)
-        | Error (`Msg msg) ->
-            Logs.err (fun l -> l "Error while preprocessing: %s" msg);
-            (acc, renames))
-      ([], renames) [ directory ]
+        | Ok (Some (sexps, renames)) -> (
+            match write_sexps path sexps with
+            | Ok () -> renames
+            | Error msg ->
+                Logs.err (fun l ->
+                    l "Error while writing file %a: %a" Fpath.pp path
+                      Rresult.R.pp_msg msg);
+                renames)
+        | Ok None -> renames
+        | Error msg ->
+            Logs.err (fun l ->
+                l "Error while preprocessing: %a " Rresult.R.pp_msg msg);
+            renames)
+      renames [ directory ]
   in
-  (* apply the renames to the files *)
-  Result.List.iter files ~f:(fun (path, sexps) ->
-      Logs.debug (fun l -> l "Rewriting %a to make names unique" Fpath.pp path);
-      let sexps = Dune_file.Packages.update_references renames sexps in
-      let* res =
-        Bos.OS.File.with_oc path
-          (fun oc sexps ->
-            let ppf = Format.formatter_of_out_channel oc in
-            List.iter ~f:(fun sexp -> Fmt.pf ppf "%a\n" pp_sexp sexp) sexps;
-            Ok ())
-          sexps
-      in
-      res)
+  (* iterate over all dune files and rewrite where necessary *)
+  let* res =
+    Bos.OS.Path.fold ~elements
+      (fun path acc ->
+        let* sexps =
+          Bos.OS.File.with_ic path
+            (fun ic () ->
+              match Sexplib.Sexp.input_sexps ic with
+              | sexp -> Some sexp
+              | exception _ -> None)
+            ()
+        in
+        match sexps with
+        | None -> acc
+        | Some sexps -> (
+            let Dune_file.Packages.{ changed; stanzas; renames = _ } =
+              Dune_file.Packages.update_references renames sexps
+            in
+            match changed with
+            | false -> acc
+            | true ->
+                Logs.debug (fun l ->
+                    l "Rewriting %a to make names unique" Fpath.pp path);
+                write_sexps path stanzas))
+      (Ok ()) [ directory ]
+  in
+  res
 
 let pull ?(trim_clone = false) ~global_state ~duniverse_dir src_dep =
   let open Result.O in