From 9c8ecc9fbcb987f81c367371d3f21da14d3c2617 Mon Sep 17 00:00:00 2001
From: Rudi Grinberg <rudi.grinberg@gmail.com>
Date: Tue, 7 Nov 2017 21:41:09 +0800
Subject: [PATCH] Improve jbuilder exec (#286)

* Improve jbuilder exec

When the path passed contianed to exec contains a '/', it will be interpreted
relative to the path of a build context (default context when absent)

* Update man page of jbuilder exec

* Add String.drop_prefix

* Make jbuilder exec understand relative/absolute paths

jbuilder exec will now interpret absolute paths as relative to the specified
build context. While relative paths will now be intepreted relative to the cwd
appended to the specified build context.

* Fix jbuilder exec /absolute/path

When the path provided to jbuilder exec is absolute, we should ignore the build
context for looking up the binary.

* Fix exec when ran outside of root

Previously, a call like $ jbuilder exec ./xxx --root=p would raise
an exception. Now ./xxx will be intepreterd relative to --root.

* Fix relative paths when jbuilder is ran outside of --root

* Simplify documentation for jbuilder exec
---
 bin/main.ml   | 34 +++++++++++++++++++++++++++++-----
 src/import.ml |  9 +++++++++
 2 files changed, 38 insertions(+), 5 deletions(-)

diff --git a/bin/main.ml b/bin/main.ml
index a5ce27d7..57157126 100644
--- a/bin/main.ml
+++ b/bin/main.ml
@@ -816,21 +816,45 @@ let exec =
   in
   let man =
     [ `S "DESCRIPTION"
-    ; `P {|$(b,jbuilder exec -- COMMAND) should behave in the same way as if you do:|}
+    ; `P {|$(b,jbuilder exec -- COMMAND) should behave in the same way as if you
+           do:|}
     ; `Pre "  \\$ jbuilder install\n\
            \  \\$ COMMAND"
-    ; `P {|In particular if you run $(b,jbuilder exec ocaml), you will have access
-           to the libraries defined in the workspace using your usual directives
-           ($(b,#require) for instance)|}
+    ; `P {|In particular if you run $(b,jbuilder exec ocaml), you will have
+           access to the libraries defined in the workspace using your usual
+           directives ($(b,#require) for instance)|}
+    ; `P {|When a leading / is present in the command (absolute path), then the
+           path is interpreted as an absolute path|}
+    ; `P {|When a / is present at any other position (relative path), then the
+           path is interpreted as relative to the build context + current
+           working directory (or the value of $(b,--root) when ran outside of
+           the project root)|}
     ; `Blocks help_secs
     ]
   in
   let go common context prog args =
+    let runcwd = Sys.getcwd () in
     set_common common ~targets:[];
     let log = Log.create () in
     let setup = Future.Scheduler.go ~log (Main.setup ~log common) in
     let context = Main.find_context_exn setup ~name:context in
-    let path = Config.local_install_bin_dir ~context:context.name :: context.path in
+    let (prog, path) =
+      match String.index prog '/' with
+      | None ->
+        (prog, Config.local_install_bin_dir ~context:context.name :: context.path)
+      | Some i ->
+        let p = Path.of_string prog in
+        let path =
+          if i = 0 then (
+            Path.parent p
+          ) else (
+            match String.drop_prefix runcwd ~prefix:common.root with
+            | None ->
+              Path.append context.build_dir (Path.parent p)
+            | Some s ->
+              Path.append (Path.relative context.build_dir s) (Path.parent p)
+          ) in
+        (Path.basename p, [path]) in
     match Bin.which ~path prog with
     | None ->
       Format.eprintf "@{<Error>Error@}: Program %S not found!@." prog;
diff --git a/src/import.ml b/src/import.ml
index 4c3f84b9..00ff05b9 100644
--- a/src/import.ml
+++ b/src/import.ml
@@ -209,6 +209,15 @@ module String = struct
     len >= suffix_len &&
     sub s ~pos:(len - suffix_len) ~len:suffix_len = suffix
 
+  let drop_prefix s ~prefix =
+    if is_prefix s ~prefix then
+      if length s = length prefix then
+        Some ""
+      else
+        Some (sub s ~pos:(length prefix) ~len:(length s - length prefix - 1))
+    else
+      None
+
   include struct
     [@@@warning "-3"]
     let capitalize_ascii   = String.capitalize