refactor: add Path.drop_prefix and Path.drop_prefix_exn

Signed-off-by: Antonio Nuno Monteiro <[email protected]>

otherlibs/stdune/src/path.ml

@@ -1265,6 +1265,18 @@ let chmod t ~mode = Unix.chmod (to_string t) mode
 let follow_symlink path =
   Fpath.follow_symlink (to_string path) |> Result.map ~f:of_string
 
+let drop_prefix path ~prefix =
+  String.drop_prefix (to_string path) ~prefix:(to_string prefix)
+  |> Option.map ~f:(fun p ->
+         String.drop_prefix_if_exists ~prefix:"/" p |> Local.of_string)
+
+let drop_prefix_exn t ~prefix =
+  match drop_prefix t ~prefix with
+  | None ->
+    Code_error.raise "Path.drop_prefix_exn"
+      [ ("t", to_dyn t); ("prefix", to_dyn prefix) ]
+  | Some p -> p
+
 module Expert = struct
   let drop_absolute_prefix ~prefix p =
     match

otherlibs/stdune/src/path.mli

@@ -447,6 +447,14 @@ val chmod : t -> mode:int -> unit
 (** Attempts to resolve a symlink. Returns [None] if the path isn't a symlink *)
 val follow_symlink : t -> (t, Fpath.follow_symlink_error) result
 
+(** [drop_prefix_exn t ~prefix] drops the [prefix] from a path, including any
+    leftover `/` prefix. Raises a [Code_error.t] if the prefix wasn't found. *)
+val drop_prefix_exn : t -> prefix:t -> Local.t
+
+(** [drop_prefix t ~prefix] drops the [prefix] from a path, including any
+    leftover `/` prefix. Returns [None] if the prefix wasn't found. *)
+val drop_prefix : t -> prefix:t -> Local.t option
+
 module Expert : sig
   (** Attempt to convert external paths to source/build paths. Don't use this
       function unless strictly necessary. It's not completely reliable and we

src/dune_rules/install_rules.ml

@@ -207,11 +207,8 @@ end = struct
           let dir' = Obj_dir.cm_dir external_obj_dir cm_kind visibility in
           if Path.equal (Path.build dir) dir' then None
           else
-            String.drop_prefix (Path.to_string dir')
-              ~prefix:(Path.Build.to_string dir)
-            |> Option.value_exn
-            |> String.drop_prefix_if_exists ~prefix:"/"
-            |> Option.some
+            Path.drop_prefix_exn dir' ~prefix:(Path.build dir)
+            |> Path.Local.to_string |> Option.some
       in
       let if_ b (cm_kind, f) =
         if b then

src/dune_rules/melange/melange_rules.ml

@@ -29,14 +29,9 @@ let output_of_lib ~target_dir lib =
           [ "node_modules"; Lib_name.to_string lib_name ] )
 
 let lib_output_path ~output_dir ~lib_dir src =
-  let dir =
-    let src_dir = Path.to_string src in
-    let lib_dir = Path.to_string lib_dir in
-    String.drop_prefix src_dir ~prefix:lib_dir
-    |> Option.value_exn
-    |> String.drop_prefix_if_exists ~prefix:"/"
-  in
-  if dir = "" then output_dir else Path.Build.relative output_dir dir
+  match Path.drop_prefix_exn src ~prefix:lib_dir |> Path.Local.to_string with
+  | "" -> output_dir
+  | dir -> Path.Build.relative output_dir dir
 
 let make_js_name ~js_ext ~output m =
   let basename = Melange.js_basename m ^ js_ext in

src/dune_rules/module_compilation.ml

@@ -63,17 +63,14 @@ let melange_args (cctx : Compilation_context.t) (cm_kind : Lib_mode.Cm_kind.t)
       | Some lib_name ->
         let dir =
           let package_output = Path.as_in_build_dir_exn package_output in
-          let lib_root_dir =
-            Path.Build.to_string (Compilation_context.dir cctx)
-          in
-          let src_dir = Path.Build.to_string package_output in
+          let lib_root_dir = Path.build (Compilation_context.dir cctx) in
+          let src_dir = Path.build package_output in
           let build_dir =
             (Compilation_context.super_context cctx |> Super_context.context)
               .build_dir
           in
-          String.drop_prefix src_dir ~prefix:lib_root_dir
-          |> Option.value_exn
-          |> String.drop_prefix_if_exists ~prefix:"/"
+          Path.drop_prefix_exn src_dir ~prefix:lib_root_dir
+          |> Path.Local.to_string
           |> Path.Build.relative build_dir
         in
 

test/blackbox-tests/test-cases/melange/emit-private.t

@@ -38,6 +38,7 @@ Test dependency on a private library in the same package as melange.emit
   >  (target dist)
   >  (alias dist)
   >  (libraries a)
+  >  (emit_stdlib false)
   >  (package a))
   > EOF