Merge pull request #799 from vitoshka/dict-api

Expand nREPL dict api and apply throughout

Author: bbatsov

cider-doc.el

@@ -351,8 +351,9 @@ Tables are marked to be ignored by line wrap."
           (newline))
         (let ((beg (point-min))
               (end (point-max)))
-          (cl-loop for x on info by #'cddr 
-                   do (put-text-property beg end (car x) (cadr x)))))
+          (nrepl-dict-map (lambda (k v)
+                            (put-text-property beg end k v))
+                          info)))
       (current-buffer))))
 
 (defun cider-docview-render (buffer symbol info)

cider-eldoc.el

@@ -96,16 +96,16 @@ POS is the index of current argument."
   "Return the arglist for THING."
   (when (nrepl-op-supported-p "info")
     (let* ((var-info (cider-var-info thing t))
-           (candidates (cdr (nrepl-dict-get var-info "candidates"))))
-      (if candidates
-          (->> (cl-loop for x on candidates by #'cddr
-                        collect (nrepl-dict-get (cadr x) "arglists-str"))
-            (-map 'read)
-            -flatten
-            -distinct)
-        (let ((arglists (nrepl-dict-get var-info "arglists-str")))
-          (when arglists
-            (read arglists)))))))
+           (candidates (nrepl-dict-get var-info "candidates")))
+      (if (nrepl-dict-empty-p candidates)
+          (let ((arglists (nrepl-dict-get var-info "arglists-str")))
+            (when arglists
+              (read arglists)))
+        (->> candidates
+          (nrepl-dict-map (lambda (_ v) (nrepl-dict-get v "arglists-str") ))
+          (-map 'read)
+          -flatten
+          -distinct)))))
 
 (defun cider-eldoc ()
   "Backend function for eldoc to show argument list in the echo area."

nrepl-client.el

@@ -235,6 +235,10 @@ To be used for tooling calls (i.e. completion, eldoc, etc)")
   (and (listp object)
        (eq (car object) 'dict)))
 
+(defun nrepl-dict-empty-p (dict)
+  "Return t if nREPL dict is empty."
+  (null (cdr dict)))
+
 (defun nrepl-dict-get (dict key)
   "Get from DICT value associated with KEY.
 If dict is nil, return nil."
@@ -254,12 +258,27 @@ Return new dict.  Dict is modified by side effects."
       dict)))
 
 (defun nrepl-dict-keys (dict)
-  "Return all the keys in the nREPL dict."
+  "Return all the keys in the nREPL DICT."
   (if (nrepl-dict-p dict)
       (cl-loop for l on (cdr dict) by #'cddr
                collect (car l))
     (error "Not a nREPL dict.")))
 
+(defun nrepl-dict-vals (dict)
+  "Return all the values in the nREPL DICT."
+  (if (nrepl-dict-p dict)
+      (cl-loop for l on (cdr dict) by #'cddr
+               collect (cadr l))
+    (error "Not a nREPL dict.")))
+
+(defun nrepl-dict-map (fn dict)
+  "Map FN on nREPL DICT.
+FN must accept two arguments key and value."
+  (if (nrepl-dict-p dict)
+      (cl-loop for l on (cdr dict) by #'cddr
+               collect (funcall fn (car l) (cadr l)))
+    (error "Not a nREPL dict.")))
+
 (defun nrepl--cons (car list-or-dict)
   "Generic cons of CAR to LIST-OR-DICT."
   (if (eq (car list-or-dict) 'dict)
@@ -591,7 +610,7 @@ Falls back to `nrepl-port' if not found."
   "Destructure an nREPL RESPONSE dict.
 Bind the value of the provided KEYS and execute BODY."
   `(let ,(cl-loop for key in keys
-                  collect `(,key (lax-plist-get (cdr ,response) ,(format "%s" key))))
+                  collect `(,key (nrepl-dict-get ,response ,(format "%s" key))))
      ,@body))
 (put 'nrepl-dbind-response 'lisp-indent-function 2)
 

test/nrepl-bencode-tests.el

@@ -288,7 +288,7 @@ If object is incomplete, return a decoded path."
 
 (ert-deftest test-nrepl-dict ()
   (should (equal '(dict (23 . 44) (2 . 3) (3 . 4) (4 . 5))
-                 (nrepl--cons '(23 . 44) '(dict (2 . 3) (3 . 4) (4 . 5 )))))
+                 (nrepl--cons '(23 . 44) '(dict (2 . 3) (3 . 4) (4 . 5)))))
   (should (equal '((34))
                  (nrepl--push 34 '(()))))
   (should (equal '(((34)) (1 2 3))
@@ -300,7 +300,14 @@ If object is incomplete, return a decoded path."
   (should (equal '(((34) 1) (2))
                  (nrepl--push '(34) '((1) (2)))))
   (should (equal '((dict 34 a b) (2))
-                 (nrepl--push 34 '((dict a b) (2))))))
+                 (nrepl--push 34 '((dict a b) (2)))))
+  (should (equal '((3 . 4) nil)
+                 (nrepl-dict-vals '(dict (2 . 3) (3 . 4) (4 . 5)))))
+  (should (equal '((2 . 3) (4 . 5))
+                 (nrepl-dict-keys '(dict (2 . 3) (3 . 4) (4 . 5)))))
+  (should (equal '(1 5 9)
+                 (nrepl-dict-map (lambda (k v) (+ k v))
+                                 '(dict 0 1 2 3 4 5)))))
 
 
 ;; benchmarks