[Fix #2413] Prompt if a session with the same parameters already exists

Author: vspinu

cider-connection.el

@@ -92,6 +92,21 @@ PARAMS is a plist containing :host, :port, :server and other parameters for
   "Ensure there is a linked CIDER session."
   (sesman-ensure-session 'CIDER))
 
+(defun cider--session-server (session)
+  "Return server buffer for SESSION or nil if there is no server."
+  (seq-some (lambda (r)
+              (buffer-local-value 'nrepl-server-buffer r))
+            (cdr session)))
+
+(defun cider--gather-session-params (session)
+  "Gather all params for a SESSION."
+  (let (params)
+    (dolist (repl (cdr session))
+      (setq params (cider--gather-connect-params params repl)))
+    (when-let* ((server (cider--session-server session)))
+      (setq params (cider--gather-connect-params params server)))
+    params))
+
 (defun cider--gather-connect-params (&optional params proc-buffer)
   "Gather all relevant connection parameters into PARAMS plist.
 PROC-BUFFER is either server or client buffer, defaults to current buffer."
@@ -443,9 +458,7 @@ Fallback on `cider' command."
 (cl-defmethod sesman-restart-session ((_system (eql CIDER)) session)
   (let* ((ses-name (car session))
          (repls (cdr session))
-         (srv-buf (seq-some (lambda (r)
-                              (buffer-local-value 'nrepl-server-buffer r))
-                            repls)))
+         (srv-buf (cider--session-server session)))
     (if srv-buf
         ;; session with a server
         (let ((s-params (cider--gather-connect-params nil srv-buf)))

cider.el

@@ -923,6 +923,7 @@ With the prefix argument, prompt for all these parameters."
   (interactive "P")
   (let ((params (thread-first params
                   (cider--update-project-dir)
+                  (cider--check-existing-session)
                   (cider--update-jack-in-cmd))))
     (nrepl-start-server-process
      (plist-get params :project-dir)
@@ -944,6 +945,7 @@ prompt for all these parameters."
     ;; cider--update-jack-in-cmd relies indirectly on the above dynamic vars
     (let ((params (thread-first params
                     (cider--update-project-dir)
+                    (cider--check-existing-session)
                     (cider--update-jack-in-cmd))))
       (nrepl-start-server-process
        (plist-get params :project-dir)
@@ -967,8 +969,10 @@ cljs REPL only when the ClojureScript dependencies are met."
     ;; cider--update-jack-in-cmd relies indirectly on the above dynamic vars
     (let ((params (thread-first params
                     (cider--update-project-dir)
+                    (cider--check-existing-session)
                     (cider--update-jack-in-cmd)
                     (cider--update-cljs-type)
+                    ;; already asked, don't ask on sibling connect
                     (plist-put :do-prompt nil))))
       (nrepl-start-server-process
        (plist-get params :project-dir)
@@ -1032,6 +1036,7 @@ prefix argument, prompt for all the parameters."
    (thread-first params
      (cider--update-project-dir)
      (cider--update-host-port)
+     (cider--check-existing-session)
      (plist-put :repl-init-function nil)
      (plist-put :session-name nil)
      (plist-put :repl-type "clj"))))
@@ -1047,6 +1052,7 @@ parameters regardless of their supplied or default values."
    (thread-first params
      (cider--update-project-dir)
      (cider--update-host-port)
+     (cider--check-existing-session)
      (cider--update-cljs-type)
      (cider--update-cljs-init-function)
      (plist-put :session-name nil)
@@ -1062,6 +1068,7 @@ non-nil, don't start if ClojureScript requirements are not met."
   (let* ((params (thread-first params
                    (cider--update-project-dir)
                    (cider--update-host-port)
+                   (cider--check-existing-session)
                    (cider--update-cljs-type)))
          (clj-repl (cider-connect-clj params)))
     (if soft-cljs-start
@@ -1208,6 +1215,30 @@ non-nil, don't start if ClojureScript requirements are not met."
                               cider-offer-to-open-cljs-app-in-browser)
                      (cider--offer-to-open-app-in-browser nrepl-server-buffer)))))))
 
+(defun cider--check-existing-session (params)
+  "Ask for confirmation if a session with similar PARAMS already exists.
+If no session exists or user chose to proceed, return PARAMS.  If the user
+canceled the action, signal quit."
+  (let* ((proj-dir (plist-get params :project-dir))
+         (host (plist-get params :host))
+         (port (plist-get params :port))
+         (session (seq-find (lambda (ses)
+                              (let ((ses-params (cider--gather-session-params ses)))
+                                (and (equal proj-dir (plist-get ses-params :project-dir))
+                                     (or (null port)
+                                         (equal port (plist-get ses-params :port)))
+                                     (or (null host)
+                                         (equal host (plist-get ses-params :host))))))
+                            (sesman-linked-sessions 'CIDER '(project)))))
+    (when session
+      (unless (y-or-n-p
+               (concat
+                "A session with the same parameters exists (" (car session) ").  "
+                "You can connect a sibling instead.  Proceed? "))
+        (let ((debug-on-quit nil))
+          (signal 'quit nil)))))
+  params)
+
 
 ;;; Aliases
 

nrepl-client.el

@@ -1044,7 +1044,7 @@ been determined."
         (when (and (null nrepl-endpoint)
                    (string-match "nREPL server started on port \\([0-9]+\\)" output))
           (let ((port (string-to-number (match-string 1 output))))
-            (setq nrepl-endpoint (list :host nil :port port))
+            (setq nrepl-endpoint (list :host "localhost" :port port))
             (message "[nREPL] server started on %s" port)
             (when nrepl-on-port-callback
               (funcall nrepl-on-port-callback (process-buffer process)))))))))

test/cider-connection-tests.el

@@ -221,8 +221,6 @@
                       (setq major-mode 'clojurescript-mode)
                       (expect (cider-current-repl) :to-equal b2))))))))))))
 
-
-
 (describe "cider-repls"
 
   :var (sesman-sessions-hashmap sesman-links-alist ses-name ses-name2)
@@ -342,3 +340,26 @@
     (expect (cider-format-connection-params "%J" '(:project-dir "/etc/"))
             :to-equal "/etc")))
 
+(describe "cider-jack-in-clj&cljs"
+  :var (sesman-sessions-hashmap sesman-links-alist cider-default-cljs-repl)
+  (before-each
+    (setq sesman-sessions-hashmap (make-hash-table :test #'equal)
+          sesman-links-alist nil
+          cider-default-cljs-repl 'node)
+    (spy-on 'cider--gather-session-params
+            :and-return-value '(:project-dir "some/project" :host "localhost" :port 1234))
+    (spy-on 'nrepl-start-server-process
+            :and-return-value nil)
+    (spy-on 'sesman-linked-sessions
+            :and-return-value '(("a-session")))
+    (spy-on 'y-or-n-p
+            :and-return-value t)
+    (cider-jack-in-clj&cljs '(:project-dir "some/project" :host "localhost" :port 1234))
+    (cider-jack-in-clj&cljs '(:project-dir "some/project" :host "localhost"))
+    (cider-jack-in-clj&cljs '(:project-dir "some/project"))
+    (cider-jack-in-clj&cljs '(:project-dir "some/project" :host "other-host"))
+    (cider-jack-in-clj&cljs '(:project-dir "some/other/project")))
+  (it "detects existing project"
+    (expect 'y-or-n-p :to-have-been-called-times 3)))
+
+

test/cider-tests.el

@@ -239,8 +239,6 @@
       (expect (cider-add-clojure-dependencies-maybe nil)
               :to-equal '(("Hello, I love you" "won't you tell me your name"))))))
 
-
-
 (describe "cider-normalize-cljs-init-options"
   (describe "from options"
     (it "leaves keywords alone"