188 lines
6.5 KiB
EmacsLisp
188 lines
6.5 KiB
EmacsLisp
;;; 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
|