Move dictionary manipulation to its own file, nrepl-dict.el

A lot of .el files have to manipulate dictionaries, so this forced a lot
of files to depend on nrepl-client.el. These were muddy waters if we
plan on supporting SocketREPL.

1 files changed, 187 insertions, 0 deletions

diff --git a/nrepl-dict.el b/nrepl-dict.el
new file mode 100644
index 00000000..b6c77bbf
--- /dev/null
+++ b/nrepl-dict.el
@@ -0,0 +1,187 @@
+;;; nrepl-dict.el --- Dictionary functions for Clojure nREPL -*- lexical-binding: t -*-
+
+;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov
+;; Copyright © 2013-2016 Bozhidar Batsov, Artur Malabarba and CIDER contributors
+;;
+;; Author: Tim King <kingtim@gmail.com>
+;;         Phil Hagelberg <technomancy@gmail.com>
+;;         Bozhidar Batsov <bozhidar@batsov.com>
+;;         Artur Malabarba <bruce.connor.am@gmail.com>
+;;         Hugo Duncan <hugo@hugoduncan.org>
+;;         Steve Purcell <steve@sanityinc.com>
+;;
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;
+;; This file is not part of GNU Emacs.
+;;
+;;; Commentary:
+;;
+;; Provides functions to interact with and create `nrepl-dict's. These are
+;; simply plists with an extra element at the head.
+
+;;; Code:
+(require 'cl-lib)
+
+
+(defun nrepl-dict (&rest key-vals)
+  "Create nREPL dict from KEY-VALS."
+  (cons 'dict key-vals))
+
+(defun nrepl-dict-p (object)
+  "Return t if OBJECT is an nREPL dict."
+  (and (listp object)
+       (eq (car object) 'dict)))
+
+(defun nrepl-dict-empty-p (dict)
+  "Return t if nREPL dict DICT is empty."
+  (null (cdr dict)))
+
+(defun nrepl-dict-contains (dict key)
+  "Return nil if nREPL dict DICT doesn't contain KEY.
+If DICT does contain KEY, then a non-nil value is returned.  Due to the
+current implementation, this return value is the tail of DICT's key-list
+whose car is KEY.  Comparison is done with `equal'."
+  (member key (nrepl-dict-keys dict)))
+
+(defun nrepl-dict-get (dict key &optional default)
+  "Get from DICT value associated with KEY, optional DEFAULT if KEY not in DICT.
+If dict is nil, return nil.  If DEFAULT not provided, and KEY not in DICT,
+return nil.  If DICT is not an nREPL dict object, an error is thrown."
+  (when dict
+    (if (nrepl-dict-p dict)
+        (if (nrepl-dict-contains dict key)
+            (lax-plist-get (cdr dict) key)
+          default)
+      (error "Not an nREPL dict object: %s" dict))))
+
+(defun nrepl-dict-put (dict key value)
+  "Associate in DICT, KEY to VALUE.
+Return new dict.  Dict is modified by side effects."
+  (if (null dict)
+      (list 'dict key value)
+    (if (not (nrepl-dict-p dict))
+        (error "Not an nREPL dict object: %s" dict)
+      (setcdr dict (lax-plist-put (cdr dict) key value))
+      dict)))
+
+(defun nrepl-dict-keys (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 an 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 an 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 an nREPL dict")))
+
+(defun nrepl-dict-merge (dict1 dict2)
+  "Destructively merge DICT2 into DICT1.
+Keys in DICT2 override those in DICT1."
+  (let ((base (or dict1 '(dict))))
+    (nrepl-dict-map (lambda (k v)
+                      (nrepl-dict-put base k v))
+                    (or dict2 '(dict)))
+    base))
+
+(defun nrepl-dict-get-in (dict keys)
+  "Return the value in a nested DICT.
+KEYS is a list of keys.  Return nil if any of the keys is not present or if
+any of the values is nil."
+  (let ((out dict))
+    (while (and keys out)
+      (setq out (nrepl-dict-get out (pop keys))))
+    out))
+
+(defun nrepl-dict-flat-map (function dict)
+  "Map FUNCTION over DICT and flatten the result.
+FUNCTION follows the same restrictions as in `nrepl-dict-map', and it must
+also alway return a sequence (since the result will be flattened)."
+  (when dict
+    (apply #'append (nrepl-dict-map function dict))))
+
+
+;;; More specific functions
+(defun nrepl--cons (car list-or-dict)
+  "Generic cons of CAR to LIST-OR-DICT."
+  (if (eq (car list-or-dict) 'dict)
+      (cons 'dict (cons car (cdr list-or-dict)))
+    (cons car list-or-dict)))
+
+(defun nrepl--nreverse (list-or-dict)
+  "Generic `nreverse' which works on LIST-OR-DICT."
+  (if (eq (car list-or-dict) 'dict)
+      (cons 'dict (nreverse (cdr list-or-dict)))
+    (nreverse list-or-dict)))
+
+(defun nrepl--push (obj stack)
+  "Cons OBJ to the top element of the STACK."
+  ;; stack is assumed to be a list
+  (if (eq (caar stack) 'dict)
+      (cons (cons 'dict (cons obj (cdar stack)))
+            (cdr stack))
+    (cons (if (null stack)
+              obj
+            (cons obj (car stack)))
+          (cdr stack))))
+
+(defun nrepl--merge (dict1 dict2 &optional no-join)
+  "Join nREPL dicts DICT1 and DICT2 in a meaningful way.
+String values for non \"id\" and \"session\" keys are concatenated. Lists
+are appended. nREPL dicts merged recursively. All other objects are
+accumulated into a list. DICT1 is modified destructively and
+then returned.
+If NO-JOIN is given, return the first non nil dict."
+  (if no-join
+      (or dict1 dict2)
+    (cond ((null dict1) dict2)
+          ((null dict2) dict1)
+          ((stringp dict1) (concat dict1 dict2))
+          ((nrepl-dict-p dict1)
+           (nrepl-dict-map
+            (lambda (k2 v2)
+              (nrepl-dict-put dict1 k2
+                              (nrepl--merge (nrepl-dict-get dict1 k2) v2
+                                            (member k2 '("id" "session")))))
+            dict2)
+           dict1)
+          ((and (listp dict2) (listp dict1)) (append dict1 dict2))
+          ((listp dict1) (append dict1 (list dict2)))
+          (t (list dict1 dict2)))))
+
+
+;;; Dbind
+(defmacro nrepl-dbind-response (response keys &rest body)
+  "Destructure an nREPL RESPONSE dict.
+Bind the value of the provided KEYS and execute BODY."
+  (declare (debug (form (&rest symbolp) body)))
+  `(let ,(cl-loop for key in keys
+                  collect `(,key (nrepl-dict-get ,response ,(format "%s" key))))
+     ,@body))
+(put 'nrepl-dbind-response 'lisp-indent-function 2)
+
+(provide 'nrepl-dict)
+
+;;; nrepl-dict.el ends here