Translate paths from CIDER to nREPL and vice-versa

cider-common.el

@@ -276,32 +276,46 @@ otherwise, nil."
 
 (defcustom cider-path-translations nil
   "Alist of path prefixes to path prefixes.
-Useful to intercept the location of a path in a docker image and translate
-to the oringal location.  If your project is located at \"~/projects/foo\"
-and the src directory of foo is mounted at \"/src\" in the docker
-container, the alist would be `((\"/src\" \"~/projects/foo/src\"))"
+Useful to intercept the location of a path in a container (or virtual
+machine) and translate to the oringal location.  If your project is located
+at \"~/projects/foo\" and the src directory of foo is mounted at \"/src\"
+in the container, the alist would be `((\"/src\" \"~/projects/foo/src\"))."
   :type '(alist :key-type string :value-type string)
   :group 'cider
   :package-version '(cider . "0.23.0"))
 
-(defun cider--translate-path (path)
-  "Attempt to translate the PATH.
-Looks at `cider-path-translations' for (docker . host) alist of path
-prefixes."
-  (seq-some (lambda (translation)
-              (let ((prefix (file-name-as-directory (expand-file-name (car translation)))))
-                (when (string-prefix-p prefix path)
-                  (replace-regexp-in-string (format "^%s" (regexp-quote prefix))
-                                            (file-name-as-directory
-                                             (expand-file-name (cdr translation)))
-                                            path))))
-            cider-path-translations))
+(defun cider--translate-path (path direction)
+  "Attempt to translate the PATH in the given DIRECTION.
+Looks at `cider-path-translations' for (container . host) alist of path
+prefixes and translates PATH from container to host or viceversa depending on
+whether DIRECTION is 'from-nrepl or 'to-nrepl."
+  (seq-let [from-fn to-fn path-fn] (cond ((eq direction 'from-nrepl) '(car cdr identity))
+                                         ((eq direction 'to-nrepl) '(cdr car expand-file-name)))
+    (let ((path (funcall path-fn path)))
+      (seq-some (lambda (translation)
+                  (let ((prefix (file-name-as-directory (expand-file-name (funcall from-fn translation)))))
+                    (when (string-prefix-p prefix path)
+                      (replace-regexp-in-string (format "^%s" (regexp-quote prefix))
+                                                (file-name-as-directory
+                                                 (expand-file-name (funcall to-fn translation)))
+                                                path))))
+                cider-path-translations))))
+
+(defun cider--translate-path-from-nrepl (path)
+  "Attempt to translate the nREPL PATH to a local path."
+  (cider--translate-path path 'from-nrepl))
+
+(defun cider--translate-path-to-nrepl (path)
+  "Attempt to translate the local PATH to an nREPL path."
+  (cider--translate-path (expand-file-name path) 'to-nrepl))
 
 (defvar cider-from-nrepl-filename-function
   (with-no-warnings
-    (if (eq system-type 'cygwin)
-        #'cygwin-convert-file-name-from-windows
-      #'identity))
+    (lambda (path)
+      (let ((path* (if (eq system-type 'cygwin)
+                       (cygwin-convert-file-name-from-windows path)
+                     path)))
+        (or (cider--translate-path-from-nrepl path*) path*))))
   "Function to translate nREPL namestrings to Emacs filenames.")
 
 (defcustom cider-prefer-local-resources nil
@@ -313,16 +327,14 @@ prefixes."
   "Return PATH's local or tramp path using `cider-prefer-local-resources'.
 If no local or remote file exists, return nil."
   (let* ((local-path (funcall cider-from-nrepl-filename-function path))
-         (tramp-path (and local-path (cider--client-tramp-filename local-path)))
-         (translated-path (cider--translate-path local-path)))
+         (tramp-path (and local-path (cider--client-tramp-filename local-path))))
     (cond ((equal local-path "") "")
           ((and cider-prefer-local-resources (file-exists-p local-path))
            local-path)
           ((and tramp-path (file-exists-p tramp-path))
            tramp-path)
           ((and local-path (file-exists-p local-path))
-           local-path)
-          ((and translated-path (file-exists-p translated-path)) translated-path))))
+           local-path))))
 
 (declare-function archive-extract "arc-mode")
 (declare-function archive-zip-extract "arc-mode")

cider-eval.el

@@ -710,9 +710,11 @@ This is used by pretty-printing commands."
 
 (defvar cider-to-nrepl-filename-function
   (with-no-warnings
-    (if (eq system-type 'cygwin)
-        #'cygwin-convert-file-name-to-windows
-      #'identity))
+    (lambda (path)
+      (let ((path* (if (eq system-type 'cygwin)
+                       (cygwin-convert-file-name-to-windows path)
+                     path)))
+        (or (cider--translate-path-to-nrepl path*) path*))))
   "Function to translate Emacs filenames to nREPL namestrings.")
 
 (defun cider--prep-interactive-eval (form connection)

test/cider-common-tests.el

@@ -75,28 +75,84 @@
       (expect (cider-make-tramp-prefix "ssh" nil "test.local")
               :to-equal "/ssh:test.local:")))
 
-(defun cider--translate-path-test (translations file)
+(defun cider--translate-path-test (translations file direction)
   (let ((cider-path-translations translations))
-    (cider--translate-path file)))
-
-(describe "cider--translate-docker"
-  (it "translates filepaths from docker location to host location"
-    (expect (cider--translate-path-test '(("/docker/src" . "/home/host/project/src"))  "/docker/src/namespace.clj")
-            :to-equal "/home/host/project/src/namespace.clj"))
-  (it "returns nil if no prefixes match"
-    (expect (cider--translate-path-test '(("/docker/src" . "/home/host/project/src")) "/home/host/random/file.clj")
-            :to-equal nil))
-  (it "won't replace a prefix in the middle of the path"
-    (expect (cider--translate-path-test '(("/src" . "/host")) "/src/project/src/ns.clj")
-            :to-equal "/host/project/src/ns.clj"))
-  (it "handles slashes or no slashes in translations"
-    (expect (cider--translate-path-test '(("/src" . "/host/")) "/src/project/src/ns.clj")
-            :to-equal "/host/project/src/ns.clj")
-    (expect (cider--translate-path-test '(("/src/" . "/host")) "/src/project/src/ns.clj")
-            :to-equal "/host/project/src/ns.clj"))
-  (it "expands the destination filepaths"
-    (expect (cider--translate-path-test '(("/src/" . "~/host")) "/src/project/src/ns.clj")
-            :to-equal (expand-file-name "~/host/project/src/ns.clj")))
-  (it "ensures the prefix has a slash"
-    (expect (cider--translate-path-test '(("/docker" . "/host")) "/docker/ns.clj")
-            :to-equal "/host/ns.clj")))
+    (cider--translate-path file direction)))
+
+(defun cider--translate-path-from-nrepl-test (translations file)
+  (let ((cider-path-translations translations))
+    (cider--translate-path-from-nrepl file)))
+
+(defun cider--translate-path-to-nrepl-test (translations file)
+  (let ((cider-path-translations translations))
+    (cider--translate-path-to-nrepl file)))
+
+(describe "cider--translate-container-vm"
+  (it "translates file paths from container/vm location to host location"
+      (expect (cider--translate-path-test '(("/docker/src" . "/home/host/project/src")) "/docker/src/namespace.clj" 'from-nrepl)
+              :to-equal "/home/host/project/src/namespace.clj")
+      (expect (cider--translate-path-from-nrepl-test '(("/docker/src" . "/home/host/project/src")) "/docker/src/namespace.clj")
+              :to-equal "/home/host/project/src/namespace.clj"))
+  (it "returns nil if no prefixes match ('from-nrepl)"
+      (expect (cider--translate-path-test '(("/docker/src" . "/home/host/project/src")) "/home/host/random/file.clj" 'from-nrepl)
+              :to-equal nil)
+      (expect (cider--translate-path-from-nrepl-test '(("/docker/src" . "/home/host/project/src")) "/home/host/random/file.clj")
+              :to-equal nil))
+  (it "won't replace a prefix in the middle of the path ('from-nrepl)"
+      (expect (cider--translate-path-test '(("/src" . "/host")) "/src/project/src/ns.clj" 'from-nrepl)
+              :to-equal "/host/project/src/ns.clj")
+      (expect (cider--translate-path-from-nrepl-test '(("/src" . "/host")) "/src/project/src/ns.clj")
+              :to-equal "/host/project/src/ns.clj"))
+  (it "handles slashes or no slashes in translations ('from-nrepl)"
+      (expect (cider--translate-path-test '(("/src" . "/host/")) "/src/project/src/ns.clj" 'from-nrepl)
+              :to-equal "/host/project/src/ns.clj")
+      (expect (cider--translate-path-test '(("/src/" . "/host")) "/src/project/src/ns.clj" 'from-nrepl)
+              :to-equal "/host/project/src/ns.clj")
+      (expect (cider--translate-path-from-nrepl-test '(("/src" . "/host/")) "/src/project/src/ns.clj")
+              :to-equal "/host/project/src/ns.clj")
+      (expect (cider--translate-path-from-nrepl-test '(("/src/" . "/host")) "/src/project/src/ns.clj")
+              :to-equal "/host/project/src/ns.clj"))
+  (it "expands the destination file paths"
+      (expect (cider--translate-path-test '(("/src/" . "~/host")) "/src/project/src/ns.clj" 'from-nrepl)
+              :to-equal (expand-file-name "~/host/project/src/ns.clj"))
+      (expect (cider--translate-path-from-nrepl-test '(("/src/" . "~/host")) "/src/project/src/ns.clj")
+              :to-equal (expand-file-name "~/host/project/src/ns.clj")))
+  (it "ensures the prefix has a slash ('from-nrepl)"
+      (expect (cider--translate-path-test '(("/docker" . "/host")) "/docker/ns.clj" 'from-nrepl)
+              :to-equal "/host/ns.clj")
+      (expect (cider--translate-path-from-nrepl-test '(("/docker" . "/host")) "/docker/ns.clj")
+              :to-equal "/host/ns.clj"))
+  (it "translates file paths from host location to container/vm location"
+      (expect (cider--translate-path-test '(("/docker/src" . "/home/host/project/src")) "/home/host/project/src/namespace.clj" 'to-nrepl)
+              :to-equal "/docker/src/namespace.clj")
+      (expect (cider--translate-path-to-nrepl-test '(("/docker/src" . "/home/host/project/src")) "/home/host/project/src/namespace.clj")
+              :to-equal "/docker/src/namespace.clj"))
+  (it "returns nil if no prefixes match ('to-nrepl)"
+      (expect (cider--translate-path-test '(("/docker/src" . "/home/host/project/src")) "/home/host/random/file.clj" 'to-nrepl)
+              :to-equal nil)
+      (expect (cider--translate-path-to-nrepl-test '(("/docker/src" . "/home/host/project/src")) "/home/host/random/file.clj")
+              :to-equal nil))
+  (it "won't replace a prefix in the middle of the path ('to-nrepl)"
+      (expect (cider--translate-path-test '(("/src" . "/host")) "/host/project/host/ns.clj" 'to-nrepl)
+              :to-equal "/src/project/host/ns.clj")
+      (expect (cider--translate-path-to-nrepl-test '(("/src" . "/host")) "/host/project/host/ns.clj")
+              :to-equal "/src/project/host/ns.clj"))
+  (it "handles slashes or no slashes in translations ('to-nrepl)"
+      (expect (cider--translate-path-test '(("/src" . "/host/")) "/host/project/src/ns.clj" 'to-nrepl)
+              :to-equal  "/src/project/src/ns.clj")
+      (expect (cider--translate-path-test '(("/src/" . "/host")) "/host/project/src/ns.clj" 'to-nrepl)
+              :to-equal "/src/project/src/ns.clj")
+      (expect (cider--translate-path-to-nrepl-test '(("/src" . "/host/")) "/host/project/src/ns.clj")
+              :to-equal  "/src/project/src/ns.clj")
+      (expect (cider--translate-path-to-nrepl-test '(("/src/" . "/host")) "/host/project/src/ns.clj")
+              :to-equal "/src/project/src/ns.clj"))
+  (it "expands the source file paths"
+      (expect (cider--translate-path-test '(("/src/" . "~/host")) "~/host/project/src/ns.clj" 'to-nrepl)
+              :to-equal "/src/project/src/ns.clj")
+      (expect (cider--translate-path-to-nrepl-test '(("/src/" . "~/host")) "~/host/project/src/ns.clj")
+              :to-equal "/src/project/src/ns.clj"))
+  (it "ensures the prefix has a slash ('to-nrepl)"
+      (expect (cider--translate-path-test '(("/docker" . "/host")) "/host/ns.clj" 'to-nrepl)
+              :to-equal "/docker/ns.clj")
+      (expect (cider--translate-path-to-nrepl-test '(("/docker" . "/host")) "/host/ns.clj")
+              :to-equal "/docker/ns.clj")))

test/cider-interaction-tests.el

@@ -42,18 +42,26 @@
             :to-equal "a.two-three.b")))
 
 (describe "cider-to-nrepl-filename-function"
-  (let ((windows-file-name "C:/foo/bar")
-        (unix-file-name "/cygdrive/c/foo/bar"))
-    (if (eq system-type 'cygwin)
-        (and (expect (funcall cider-from-nrepl-filename-function windows-file-name)
-                     :to-equal unix-file-name)
-             (expect (funcall cider-to-nrepl-filename-function unix-file-name)
-                     :to-equal windows-file-name))
-
-      (and (expect (funcall cider-from-nrepl-filename-function unix-file-name)
-                   :to-equal unix-file-name)
-           (expect (funcall cider-to-nrepl-filename-function unix-file-name)
-                   :to-equal unix-file-name)))))
+  (it "translates file paths when running on cygwin systems"
+    (let ((windows-file-name "C:/foo/bar")
+          (unix-file-name "/cygdrive/c/foo/bar"))
+      (if (eq system-type 'cygwin)
+          (progn
+            (expect (funcall cider-from-nrepl-filename-function windows-file-name)
+                    :to-equal unix-file-name)
+            (expect (funcall cider-to-nrepl-filename-function unix-file-name)
+                    :to-equal windows-file-name))
+        (progn
+          (expect (funcall cider-from-nrepl-filename-function unix-file-name)
+                  :to-equal unix-file-name)
+          (expect (funcall cider-to-nrepl-filename-function unix-file-name)
+                  :to-equal unix-file-name)))))
+  (it "translates file paths from container/vm location to host location"
+    (let ((cider-path-translations '(("/docker/src" . "/cygdrive/c/project/src"))))
+      (expect (funcall cider-from-nrepl-filename-function "/docker/src/ns.clj")
+              :to-equal "/cygdrive/c/project/src/ns.clj")
+      (expect (funcall cider-to-nrepl-filename-function "/cygdrive/c/project/src/ns.clj")
+              :to-equal "/docker/src/ns.clj"))))
 
 (describe "cider-quit"
   (it "raises a user error if cider is not connected"