Merge pull request ocaml#9184 from ocaml/ps/rr/refactor__improve_subs…

…titution_in_files

refactor: improve substitution in files

src/dune_pkg/substs.ml

@@ -33,20 +33,95 @@ end
 
 module Map = Var.Map
 
-let subst env self ~src ~dst =
-  let self' = self |> Package_name.to_string |> OpamPackage.Name.of_string in
-  let env full_variable =
-    let variable = OpamVariable.Full.variable full_variable in
-    let package =
-      OpamVariable.Full.package ~self:self' full_variable
-      |> Option.map ~f:Package_name.of_opam_package_name
+module Make (Monad : sig
+    type 'a t
+
+    module O : sig
+      val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
+    end
+
+    module List : sig
+      val map : 'a list -> f:('a -> 'b t) -> 'b list t
+    end
+  end) =
+struct
+  open Monad.O
+
+  let is_opam_format src fname =
+    let fname = OpamFilename.to_string fname in
+    try
+      let _ = OpamParser.FullPos.string src fname in
+      true
+    with
+    | _ -> false
+  ;;
+
+  let default _ = ""
+  let unquoted env write s = write @@ OpamFilter.expand_string ~default env s
+
+  let expand_interpolations_in_opam src env write =
+    (* Determine if the input file parses in opam-file-format *)
+    let quoted s =
+      write
+      @@ OpamFilter.expand_string_aux ~escape_value:OpamFilter.escape_value ~default env s
+    in
+    OpamInterpLexer.main (unquoted env write) quoted (Lexing.from_string src)
+  ;;
+
+  let expand_interpolations_line_wise lines env write =
+    let rec aux = function
+      | [] -> ()
+      | line :: lines ->
+        unquoted env write line;
+        write "\n";
+        aux lines
     in
-    let key = { Var.T.package; variable } in
-    match Map.find env key with
-    | Some _ as v -> v
-    | None -> Map.find env { Var.T.package = Some self; variable }
-  in
-  let src = OpamFilename.of_string (Path.to_string src) in
-  let dst = OpamFilename.of_string (Path.Build.to_string dst) in
-  OpamFilter.expand_interpolations_in_file_full env ~src ~dst
-;;
+    aux lines
+  ;;
+
+  let subst env self ~src ~dst =
+    let contents =
+      let contents = Io.read_file src in
+      let fname = OpamFilename.of_string (Path.to_string src) in
+      if is_opam_format contents fname
+      then `Opam contents
+      else `Lines (String.split_lines contents)
+    in
+    let expand =
+      match contents with
+      | `Opam contents -> expand_interpolations_in_opam contents
+      | `Lines lines -> expand_interpolations_line_wise lines
+    in
+    let variables =
+      let write _ = () in
+      let variables = ref OpamVariable.Full.Set.empty in
+      let env var =
+        variables := OpamVariable.Full.Set.add var !variables;
+        None
+      in
+      expand env write;
+      !variables
+    in
+    let env =
+      let self' = self |> Package_name.to_string |> OpamPackage.Name.of_string in
+      fun full_variable ->
+        let variable = OpamVariable.Full.variable full_variable in
+        let package =
+          OpamVariable.Full.package ~self:self' full_variable
+          |> Option.map ~f:Package_name.of_opam_package_name
+        in
+        env { Var.package; variable }
+    in
+    let+ expansions =
+      let+ expanded =
+        OpamVariable.Full.Set.to_list_map Fun.id variables
+        |> Monad.List.map ~f:(fun var ->
+          let+ value = env var in
+          var, value)
+      in
+      OpamVariable.Full.Map.of_list expanded
+    in
+    let env var = OpamVariable.Full.Map.find var expansions in
+    Io.with_file_out (Path.build dst) ~f:(fun oc -> expand env (output_string oc))
+  ;;
+end

src/dune_pkg/substs.mli

@@ -22,9 +22,21 @@ module Var : sig
   val to_dyn : t -> Dyn.t
 end
 
-val subst
-  :  OpamVariable.variable_contents Var.Map.t
-  -> Package_name.t
-  -> src:Path.t
-  -> dst:Path.Build.t
-  -> unit
+module Make (Monad : sig
+    type 'a t
+
+    module O : sig
+      val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
+    end
+
+    module List : sig
+      val map : 'a list -> f:('a -> 'b t) -> 'b list t
+    end
+  end) : sig
+  val subst
+    :  (Var.t -> OpamVariable.variable_contents option Monad.t)
+    -> Package_name.t
+    -> src:Path.t
+    -> dst:Path.Build.t
+    -> unit Monad.t
+end

src/dune_rules/pkg_rules.ml

@@ -379,6 +379,18 @@ module Pkg_installed = struct
 end
 
 module Substitute = struct
+  include Substs.Make (struct
+      type 'a t = 'a
+
+      module O = struct
+        let ( let+ ) x f = f x
+      end
+
+      module List = struct
+        let map t ~f = List.map t ~f
+      end
+    end)
+
   module Spec = struct
     type ('path, 'target) t =
       (* XXX it's not good to serialize the substitution map like this. We're
@@ -416,10 +428,19 @@ module Substitute = struct
       List [ Dune_lang.atom_or_quoted_string name; List e; s; input i; output o ]
     ;;
 
-    let action (env, self, src, dst) ~ectx:_ ~eenv:_ =
+    let action
+      ((env : OpamVariable.variable_contents Substs.Var.Map.t), self, src, dst)
+      ~ectx:_
+      ~eenv:_
+      =
       let open Fiber.O in
       let+ () = Fiber.return () in
-      Substs.subst env ~src self ~dst
+      let env var =
+        match Substs.Var.Map.find env var with
+        | Some _ as v -> v
+        | None -> Substs.Var.Map.find env { var with Substs.Var.package = Some self }
+      in
+      subst env ~src self ~dst
     ;;
   end
 

vendor/opam/src/format/opamFilter.mli

@@ -222,3 +222,13 @@ val atomise_extended:
 val sort_filtered_formula:
   ((name * condition) -> (name * condition) -> int) -> filtered_formula ->
   filtered_formula
+
+val escape_value : string -> string
+
+val expand_string_aux :
+    ?partial:bool ->
+    ?escape_value:(string -> string) ->
+    ?default:(string -> string) ->
+    (full_variable -> variable_contents option) ->
+    string ->
+    string