Merge pull request #2041 from rgrinberg/local-path-dst-file-bindings

Make File_bindings.Expanded.t type more precise

src/file_binding.ml

@@ -6,7 +6,7 @@ type ('src, 'dst) t =
   }
 
 module Expanded = struct
-  type nonrec t = (Loc.t * Path.t, Loc.t * string) t
+  type nonrec t = (Loc.t * Path.t, Loc.t * Path.Local.t) t
 
   let src t = snd t.src
   let dst t = Option.map ~f:snd t.dst
@@ -21,9 +21,10 @@ module Expanded = struct
       let basename = Path.basename src in
       String.drop_suffix basename ~suffix:".exe"
       |> Option.value ~default:basename
+      |> Path.Local.of_string
 
   let dst_path t ~dir =
-    Path.relative dir (dst_basename t)
+    Path.append_local dir (dst_basename t)
 end
 
 module Unexpanded = struct
@@ -43,7 +44,12 @@ module Unexpanded = struct
       (loc, Path.relative dir expanded)
     in
     { src
-    ; dst = Option.map ~f t.dst
+    ; dst =
+        let f sw =
+          let (loc, p) = f sw in
+          (loc, Path.Local.of_string p)
+        in
+        Option.map ~f t.dst
     }
 
   module L = struct

src/file_binding.mli

@@ -4,7 +4,7 @@ module Expanded : sig
   type t
 
   val src : t -> Path.t
-  val dst : t -> string option
+  val dst : t -> Path.Local.t option
 
   val src_loc : t -> Loc.t
 

src/install_rules.ml

@@ -365,7 +365,8 @@ let init_binary_artifacts sctx package =
               List.map files ~f:(fun fb ->
                 let loc = File_binding.Expanded.src_loc fb in
                 let src = File_binding.Expanded.src fb in
-                let dst = File_binding.Expanded.dst fb in
+                let dst = Option.map ~f:Path.Local.to_string
+                            (File_binding.Expanded.dst fb) in
                 ( Some loc
                 , Install.Entry.make section src ?dst
                 )))

src/stdune/path.mli

@@ -6,6 +6,7 @@ module Local : sig
   val to_sexp : t -> Sexp.t
   val equal : t -> t -> bool
   val to_string : t -> string
+  val of_string : ?error_loc:Loc0.t -> string -> t
   val pp : Format.formatter -> t -> unit
   module L : sig
     val relative : ?error_loc:Loc0.t -> t -> string list -> t