Translate paths when cider-path-translations alist is set (#2606)

If you connect to a running docker image, often the source is mounted
in the docker image. This breaks navigation as rather than navigating
to "/home/me/projects/foo/src/ns.clj" it believes the file is
"/src/ns.clj". This allows rewriting of these prefixes so the
locations can map back to the local filesystem.

Author: dpsutton

CHANGELOG.md

@@ -5,6 +5,7 @@
 ### New features
 
 * New configuration variable `cider-result-overlay-position` determining where debugger and inline eval result overlays should be displayed. Current options are 'at-eol and 'at-point.
+* [#2606](https://github.com/clojure-emacs/cider/pull/2606): Defcustom `cider-path-translations` for translating paths from nrepl messages
 
 ### Changes
 

cider-common.el

@@ -255,6 +255,29 @@ otherwise, nil."
         localname)
     name))
 
+(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\"))"
+  :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))
+
 (defvar cider-from-nrepl-filename-function
   (with-no-warnings
     (if (eq system-type 'cygwin)
@@ -271,14 +294,16 @@ otherwise, nil."
   "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))))
+         (tramp-path (and local-path (cider--client-tramp-filename local-path)))
+         (translated-path (cider--translate-path 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))))
+           local-path)
+          ((and translated-path (file-exists-p translated-path)) translated-path))))
 
 (declare-function archive-extract "arc-mode")
 (declare-function archive-zip-extract "arc-mode")

doc/modules/ROOT/pages/config/basic_config.adoc

@@ -83,6 +83,32 @@ To prefer local resources to remote resources (tramp) when both are available:
 (setq cider-prefer-local-resources t)
 ----
 
+== Translate paths
+
+If you wish to translate paths from your running instance you may use
+the `cider-path-translations` defcustom to do so. For instance,
+suppose your app is running in a docker container with your source
+directories mounted. The navigation paths will be relative to the
+source in the docker container rather than the correct path on your
+host machine. You can add translations easily by setting the
+following, most likely in dir locals:
+
+[source,lisp]
+----
+((nil
+  (cider-path-translations . (("/root" . "/Users/foo")
+                              ("/src/" . "/Users/foo/projects")))))
+---
+
+Each entry will be interpreted as a directory entry so trailing slash
+is optional. Navigation will attempt to translate these locations, and
+if they exist, navigate there rather than report the file does not
+exist. In the example above, the m2 directory is mounted at /root/.m2
+and the source at /src. These translations would map these locations
+back to the users computer so that navigation would work.
+
+
+
 == Auto-Save Clojure Buffers on Load
 
 Normally, CIDER prompts you to save a modified Clojure buffer when you

test/cider-common-tests.el

@@ -74,3 +74,29 @@
               :to-equal "/ssh:test.cider.com:")
       (expect (cider-make-tramp-prefix "ssh" nil "test.local")
               :to-equal "/ssh:test.local:")))
+
+(defun cider--translate-path-test (translations file)
+  (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")))