[Fix #776, #773, #733] Rewrite bencode decoder

vspinu · vspinu · commit d6dcc140d738 · 2014-09-08T20:04:30.000-07:00
- nREPL dicts are now plists and accessor api is given by `nrepl-dict-p`,
    `nrepl-dict-get` and `nrepl-dict-put`.
  - nested stack is used for decoded messages to avoid re-parsing of incomplete messages
  - queues are used for raw strings from server and for decoded requests
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -20,6 +20,11 @@ are used to translate filenames from/to the nREPL server (default Cygwin impleme
 
 ### Changes
 
+* bencode decoder was rewriten:
+  - nREPL dicts are now plists and accessor api is given by `nrepl-dict-p`,
+    `nrepl-dict-get` and `nrepl-dict-put`.
+  - nested stack is used for decoded messages to avoid re-parsing of incomplete messages
+  - queues are used for incoming strings from the server and for the decoded responses
 * REPL buffers are now connection buffers for REPL client connections.
 * Server and client cranking were isolated into `nrepl-start-server-process` and
   `nrepl-start-client-process`.
diff --git a/cider-client.el b/cider-client.el
@@ -169,34 +169,17 @@ loaded."
     (buffer-local-value 'nrepl-repl-buffer
                         (get-buffer (nrepl-current-connection-buffer)))))
 
-(defun cider--dict-to-alist (val)
-  "Transforms a nREPL bdecoded dict VAL into an alist.
-Simply returns it if it's not a dict."
-  (if (and (listp val)
-           (eq (car val) 'dict))
-      (-map '-cons-to-list (cdr val))
-    val))
-
-(defun cider--dict-to-plist (val)
-  "Transforms a nREPL bdecoded dict VAL into a plist with symbol keys.
-Simply returns it if it's not a dict."
-  (if (and (listp val)
-           (eq (car val) 'dict))
-      (-interleave (-map 'intern (-map 'car (cdr val)))
-                   (-map 'cdr (cdr val)))
-    val))
-
 (defun cider--var-choice (var-info)
   "Prompt to choose from among multiple VAR-INFO candidates, if required.
 This is needed only when the symbol queried is an unqualified host platform
 method, and multiple classes have a so-named member.  If VAR-INFO does not
 contain a `candidates' key, it is returned as is."
-  (let ((candidates (cdadr (assoc "candidates" var-info))))
+  (let ((candidates (nrepl-dict-get var-info "candidates")))
     (if candidates
-        (let* ((classes (mapcar (lambda (x) (cdr (assoc "class" x))) candidates))
+        (let* ((classes (nrepl-dict-keys candidates))
                (choice (completing-read "Member in class: " classes nil t))
-               (info (cdr (assoc choice candidates))))
-          (cider--dict-to-alist info))
+               (info (nrepl-dict-get candidates choice)))
+          info)
       var-info)))
 
 (defun cider-var-info (var &optional all)
@@ -211,25 +194,17 @@ unless ALL is truthy."
                                  "ns" (cider-current-ns)
                                  "symbol" var))
                           :value)))
-      (if all
-          (cider--dict-to-alist val)
-        (cider--var-choice
-         (cider--dict-to-alist val))))))
+      (if all val (cider--var-choice val)))))
 
 (defun cider-member-info (class member)
   "Return the CLASS MEMBER's info as an alist with list cdrs."
   (when (and class member)
-    (let ((val (plist-get (nrepl-send-sync-request
-                           (list "op" "info"
-                                 "session" (nrepl-current-session)
-                                 "class" class
-                                 "member" member))
-                          :value)))
-      (cider--dict-to-alist val))))
-
-(defun cider-get-var-attr (var-info attr)
-  "Return VAR-INFO's ATTR."
-  (cadr (assoc attr var-info)))
+    (plist-get (nrepl-send-sync-request
+                (list "op" "info"
+                      "session" (nrepl-current-session)
+                      "class" class
+                      "member" member))
+               :value)))
 
 (provide 'cider-client)
 
diff --git a/cider-doc.el b/cider-doc.el
@@ -285,21 +285,21 @@ Tables are marked to be ignored by line wrap."
 
 (defun cider-docview-render-info (buffer info)
   "Emit into BUFFER formatted INFO for the Clojure or Java symbol."
-  (let* ((ns      (cadr (assoc "ns" info)))
-         (name    (cadr (assoc "name" info)))
-         (added   (cadr (assoc "added" info)))
-         (depr    (cadr (assoc "deprecated" info)))
-         (macro   (cadr (assoc "macro" info)))
-         (special (cadr (assoc "special-form" info)))
-         (forms   (cadr (assoc "forms-str" info)))
-         (args    (cadr (assoc "arglists-str" info)))
-         (doc     (cadr (assoc "doc" info)))
-         (url     (cadr (assoc "url" info)))
-         (class   (cadr (assoc "class" info)))
-         (member  (cadr (assoc "member" info)))
-         (javadoc (cadr (assoc "javadoc" info)))
-         (super   (cadr (assoc "super" info)))
-         (ifaces  (cadr (assoc "interfaces" info)))
+  (let* ((ns      (nrepl-dict-get info "ns"))
+         (name    (nrepl-dict-get info "name"))
+         (added   (nrepl-dict-get info "added"))
+         (depr    (nrepl-dict-get info "deprecated"))
+         (macro   (nrepl-dict-get info "macro"))
+         (special (nrepl-dict-get info "special-form"))
+         (forms   (nrepl-dict-get info "forms-str"))
+         (args    (nrepl-dict-get info "arglists-str"))
+         (doc     (nrepl-dict-get info "doc"))
+         (url     (nrepl-dict-get info "url"))
+         (class   (nrepl-dict-get info "class"))
+         (member  (nrepl-dict-get info "member"))
+         (javadoc (nrepl-dict-get info "javadoc"))
+         (super   (nrepl-dict-get info "super"))
+         (ifaces  (nrepl-dict-get info "interfaces"))
          (clj-name  (if ns (concat ns "/" name) name))
          (java-name (if member (concat class "/" member) class)))
     (with-current-buffer buffer
@@ -351,14 +351,14 @@ Tables are marked to be ignored by line wrap."
           (newline))
         (let ((beg (point-min))
               (end (point-max)))
-          (dolist (x info)
-            (put-text-property beg end (car x) (cadr x)))))
+          (cl-loop for x on info by #'cddr 
+                   do (put-text-property beg end (car x) (cadr x)))))
       (current-buffer))))
 
 (defun cider-docview-render (buffer symbol info)
   "Emit into BUFFER formatted documentation for SYMBOL's INFO."
   (with-current-buffer buffer
-    (let ((javadoc (cadr (assoc "javadoc" info)))
+    (let ((javadoc (nrepl-dict-get info "javadoc"))
           (inhibit-read-only t))
       (cider-docview-mode)
 
diff --git a/cider-eldoc.el b/cider-eldoc.el
@@ -96,14 +96,14 @@ 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 (cdadr (assoc "candidates" var-info))))
+           (candidates (cdr (nrepl-dict-get var-info "candidates"))))
       (if candidates
           (->> candidates
-            (-map (lambda (x) (cdr (assoc "arglists-str" x))))
+            (-map (lambda (x) (nrepl-dict-get "arglists-str" x)))
             (-map 'read)
             -flatten
             -distinct)
-        (let ((arglists (cider-get-var-attr var-info "arglists-str")))
+        (let ((arglists (nrepl-dict-get var-info "arglists-str")))
           (when arglists
             (read arglists)))))))
 
diff --git a/cider-interaction.el b/cider-interaction.el
@@ -176,24 +176,27 @@ Signal an error if it is not supported."
   "Retrieve the underlying connection's Java version."
   (with-current-buffer (nrepl-current-connection-buffer)
     (when nrepl-versions
-      (cdr (assoc "version-string" (assoc "java" nrepl-versions))))))
+      (-> nrepl-versions
+        (nrepl-dict-get "java")
+        (nrepl-dict-get "version-string")))))
 
 (defun cider--clojure-version ()
   "Retrieve the underlying connection's Clojure version."
   (with-current-buffer (nrepl-current-connection-buffer)
     (when nrepl-versions
-      (let* ((version-dict (assoc "clojure" nrepl-versions))
-             (major (cdr (assoc "major" version-dict)))
-             (minor (cdr (assoc "minor" version-dict)))
-             (incremental (cdr (assoc "incremental" version-dict))))
+      (let* ((version-dict (nrepl-dict-get nrepl-versions "clojure"))
+             (major (nrepl-dict-get version-dict "major"))
+             (minor (nrepl-dict-get version-dict "minor"))
+             (incremental (nrepl-dict-get version-dict "incremental")))
         (format "%s.%s.%s" major minor incremental)))))
 
 (defun cider--nrepl-version ()
   "Retrieve the underlying connection's nREPL version."
   (with-current-buffer (nrepl-current-connection-buffer)
     (when nrepl-versions
-      (cdr (assoc "version-string" (assoc "nrepl" nrepl-versions))))))
-
+      (-> nrepl-versions
+        (nrepl-dict-get "nrepl")
+        (nrepl-dict-get "version-string")))))
 
 (defun cider--check-middleware-compatibility-callback (buffer)
   "A callback to check if the middleware used is compatible with CIDER."
@@ -670,7 +673,7 @@ existing file ending with URL has been found."
 not found."
   (cider-ensure-op-supported "info")
   (-when-let* ((info (cider-var-info var))
-               (file (cadr (assoc "file" info))))
+               (file (nrepl-dict-get info "file")))
     (cider-find-file file)))
 
 (defun cider-jump-to (buffer &optional pos other-buffer)
@@ -710,20 +713,20 @@ When called interactively, this operates on point."
   "Jump to location give by INFO.
 INFO object is returned by `cider-var-info' or `cider-member-info'.
 OTHER-BUFFER is passed to `cider-jamp-to'."
-  (-if-let* ((line (cadr (assoc "line" info)))
-             (file (cadr (assoc "file" info)))
+  (-if-let* ((line (nrepl-dict-get info "line"))
+             (file (nrepl-dict-get info "file"))
              (buffer (unless (cider--tooling-file-p file)
                        (cider-find-file file))))
       (cider-jump-to buffer (cons line nil) other-buffer)
         ;; var was created interactively and has no file info
-        (-if-let* ((ns (cadr (assoc "ns" info)))
-                   (name (cadr (assoc "name" info)))
-                   (buffer (cider-find-buffer ns))
-                   (pos (cider-locate-def name buffer line)))
-            (cider-jump-to buffer pos other-buffer)
-          (-if-let (name (cadr (assoc "name" info)))
-              (message "No location found for %s" name)
-            (message "No source info")))))
+    (-if-let* ((ns (nrepl-dict-get info "ns"))
+               (name (nrepl-dict-get info "name"))
+               (buffer (cider-find-buffer ns))
+               (pos (cider-locate-def name buffer line)))
+        (cider-jump-to buffer pos other-buffer)
+      (-if-let (name (nrepl-dict-get info "name"))
+          (message "No location found for %s" name)
+        (message "No source info")))))
 
 (defun cider-jump-to-var (&optional var line)
   "Jump to the definition of VAR, optionally at a specific LINE.
@@ -803,9 +806,9 @@ Currently we annotate macros, special-forms and functions,
 as it's not obvious from their names alone which is which."
   (if cider-annotate-completion-candidates
       (-when-let (info (cider-var-info symbol))
-        (let ((macro   (cadr (assoc "macro" info)))
-              (special (cadr (assoc "special-form" info)))
-              (args    (cadr (assoc "arglists-str" info))))
+        (let ((macro   (nrepl-dict-get info "macro"))
+              (special (nrepl-dict-get info "special-form"))
+              (args    (nrepl-dict-get info "arglists-str")))
           (cond
            (macro " <m>")
            (special " <s>")
@@ -830,8 +833,8 @@ as it's not obvious from their names alone which is which."
 Returns the cons of the buffer itself and the location of VAR's definition
 in the buffer."
   (-when-let* ((info (cider-var-info var))
-               (file (cadr (assoc "file" info)))
-               (line (cadr (assoc "line" info)))
+               (file (nrepl-dict-get info "file"))
+               (line (nrepl-dict-get info "line"))
                (buffer (cider-find-file file)))
     (with-current-buffer buffer
       (save-excursion
@@ -852,7 +855,7 @@ in the buffer."
   (when symbol-name
     (cider-ensure-op-supported "info")
     (let* ((info (cider-var-info symbol-name))
-           (url (cadr (assoc "javadoc" info))))
+           (url (nrepl-dict-get info "javadoc")))
       (if url
           (browse-url url)
         (error "No Javadoc available for %s" symbol-name)))))
@@ -1620,8 +1623,8 @@ under point, prompts for a var."
 (defun cider-grimoire-web-lookup (symbol)
   "Look up the grimoire documentation for SYMBOL."
   (-if-let (var-info (cider-var-info symbol))
-      (let ((name (cider-get-var-attr var-info "name"))
-            (ns (cider-get-var-attr var-info "ns")))
+      (let ((name (nrepl-dict-get var-info "name"))
+            (ns (nrepl-dict-get var-info "ns")))
         ;; TODO: add a whitelist of supported namespaces
         (browse-url (cider-grimoire-url name ns (cider--clojure-version))))
     (message "Symbol %s not resolved" symbol)))
@@ -1643,8 +1646,8 @@ under point, prompts for a var."
 (defun cider-grimoire-lookup (symbol)
   "Look up the grimoire documentation for SYMBOL."
   (-if-let (var-info (cider-var-info symbol))
-      (let ((name (cider-get-var-attr var-info "name"))
-            (ns (cider-get-var-attr var-info "ns"))
+      (let ((name (nrepl-dict-get var-info "name"))
+            (ns (nrepl-dict-get var-info "ns"))
             (url-request-method "GET")
             (url-request-extra-headers `(("Content-Type" . "text/plain"))))
         ;; TODO: add a whitelist of supported namespaces
diff --git a/cider-stacktrace.el b/cider-stacktrace.el
@@ -403,10 +403,9 @@ it wraps to 0."
          (method (button-get button 'method))
          (info (or (and var (cider-var-info var))
                    (and class method (cider-member-info class method))
-                   `(("file" ,(button-get button 'file)))))
+                   `(dict "file" ,(button-get button 'file))))
          ;; stacktrace returns more accurate line numbers
-         (info (cons `("line" ,(button-get button 'line))
-                     info)))
+         (info (nrepl-dict-put info "line" (button-get button 'line))))
     (cider--jump-to-loc-from-info info t)))
 
 (defun cider-stacktrace-jump ()
diff --git a/cider-test.el b/cider-test.el
@@ -267,7 +267,7 @@ With the actual value, the outermost '(not ...)' s-expression is removed."
   "Emit into BUFFER report detail for the TEST assertion."
   (with-current-buffer buffer
     (nrepl-dbind-response test (var context type message expected actual error)
-      (cider-propertize-region (cider--dict-to-plist test)
+      (cider-propertize-region (cdr test)
         (cider-insert (capitalize type) (cider-test-type-face type) nil " in ")
         (cider-insert var 'font-lock-function-name-face t)
         (when context  (cider-insert context 'font-lock-doc-face t))
diff --git a/cider.el b/cider.el
@@ -10,7 +10,7 @@
 ;;         Steve Purcell <steve@sanityinc.com>
 ;; URL: http://www.github.com/clojure-emacs/cider
 ;; Version: 0.8.0-cvs
-;; Package-Requires: ((clojure-mode "2.0.0") (cl-lib "0.3") (dash "2.4.1") (pkg-info "0.4") (emacs "24"))
+;; Package-Requires: ((clojure-mode "2.0.0") (cl-lib "0.3") (dash "2.4.1") (pkg-info "0.4") (emacs "24") (queue "0.1.1"))
 ;; Keywords: languages, clojure, cider
 
 ;; This program is free software: you can redistribute it and/or modify
diff --git a/nrepl-client.el b/nrepl-client.el
diff --git a/test/cider-tests.el b/test/cider-tests.el
diff --git a/test/nrepl-bencode-tests.el b/test/nrepl-bencode-tests.el
