branch: externals/dash
commit dca7bdcf7919dd3e589e0bb2fa210fcba34ec69a
Merge: 677c156 3f7bc26
Author: Matus Goljer <dota.k...@gmail.com>
Commit: GitHub <nore...@github.com>
Merge pull request #277 from yyoncho/custom-destructoring
Provided option to extend destructoring
---
dash.el | 36 +++++++++++++++++++++++++++---------
dev/examples.el | 15 +++++++++++++--
2 files changed, 40 insertions(+), 11 deletions(-)
diff --git a/dash.el b/dash.el
index fcfe5d2..4b0857f 100644
--- a/dash.el
+++ b/dash.el
@@ -1652,6 +1652,10 @@ All returned symbols are guaranteed to be unique."
(t
(cons (list s source) (dash--match-cons-1 match-form s))))))
+(defun dash--get-expand-function (type)
+ "Get expand function name for TYPE."
+ (intern (format "dash-expand:%s" type)))
+
(defun dash--match-cons-1 (match-form source &optional props)
"Match MATCH-FORM against SOURCE.
@@ -1671,7 +1675,7 @@ SOURCE is a proper or improper list."
((cdr match-form)
(cond
((and (symbolp (car match-form))
- (memq (car match-form) '(&keys &plist &alist &hash)))
+ (functionp (dash--get-expand-function (car match-form))))
(dash--match-kv (dash--match-kv-normalize-match-form match-form)
(dash--match-cons-get-cdr skip-cdr source)))
((dash--match-ignore-place-p (car match-form))
(dash--match-cons-1 (cdr match-form) source
@@ -1812,6 +1816,25 @@ kv can be any key-value store, such as plist, alist or
hash-table."
(t
(cons (list s source) (dash--match-kv-1 (cdr match-form) s (car
match-form)))))))
+(defun dash-expand:&hash (key source)
+ "Generate extracting KEY from SOURCE for &hash destructuring."
+ `(gethash ,key ,source))
+
+(defun dash-expand:&plist (key source)
+ "Generate extracting KEY from SOURCE for &plist destructuring."
+ `(plist-get ,source ,key))
+
+(defun dash-expand:&alist (key source)
+ "Generate extracting KEY from SOURCE for &alist destructuring."
+ `(cdr (assoc ,key ,source)))
+
+(defun dash-expand:&hash? (key source)
+ "Generate extracting KEY from SOURCE for &hash? destructuring.
+Similar to &hash but check whether the map is not nil."
+ `(when ,source (gethash ,key ,source)))
+
+(defalias 'dash-expand:&keys 'dash-expand:&plist)
+
(defun dash--match-kv-1 (match-form source type)
"Match MATCH-FORM against SOURCE of type TYPE.
@@ -1829,13 +1852,8 @@ Valid values are &plist, &alist and &hash."
(lambda (kv)
(let* ((k (car kv))
(v (cadr kv))
- (getter (cond
- ((or (eq type '&plist) (eq type '&keys))
- `(plist-get ,source ,k))
- ((eq type '&alist)
- `(cdr (assoc ,k ,source)))
- ((eq type '&hash)
- `(gethash ,k ,source)))))
+ (getter
+ (funcall (dash--get-expand-function type) k
source)))
(cond
((symbolp v)
(list (list v getter)))
@@ -1868,7 +1886,7 @@ Key-value stores are disambiguated by placing a token
&plist,
(let ((s (car match-form)))
(cons (list s source)
(dash--match (cddr match-form) s))))
- ((memq (car match-form) '(&keys &plist &alist &hash))
+ ((functionp (dash--get-expand-function (car match-form)))
(dash--match-kv (dash--match-kv-normalize-match-form match-form) source))
(t (dash--match-cons match-form source))))
((vectorp match-form)
diff --git a/dev/examples.el b/dev/examples.el
index 2c8a94d..f987d45 100644
--- a/dev/examples.el
+++ b/dev/examples.el
@@ -28,6 +28,11 @@
(defun square (num) (* num num))
(defun three-letters () '("A" "B" "C"))
+(defun dash-expand:&hash-or-plist (key source)
+ "Sample destructoring which works with plists and hash-tables."
+ `(if (hash-table-p ,source) (gethash ,key ,source)
+ (plist-get ,source ,key)))
+
;; Allow approximate comparison of floating-point results, to work
;; around differences in implementation between systems. Use the `~>'
;; symbol instead of `=>' to test the expected and actual values with
@@ -1144,7 +1149,8 @@ new list."
(puthash :foo 1 hash)
(puthash :bar 2 hash)
(-let (((&hash :foo :bar) hash)) (list foo bar))) => '(1 2)
- (-let (((_ &keys :foo :bar) (list 'ignored :foo 1 :bar 2))) (list foo
bar)) => '(1 2)
+ (-let (((&hash :foo (&hash? :bar)) (make-hash-table)))) => nil
+ (-let (((_ &keys :foo :bar) (list 'ignored :foo 1 :bar 2))) (list foo
bar)) => '(1 2)
;;; go over all the variations of match-form derivation
(-let (((&plist :foo foo :bar) (list :foo 1 :bar 2))) (list foo bar)) =>
'(1 2)
(-let (((&plist :foo foo :bar bar) (list :foo 1 :bar 2))) (list foo bar))
=> '(1 2)
@@ -1183,7 +1189,12 @@ new list."
(-let [(list &as _ _ _ a _ _ _ b _ _ _ c) (list 1 2 3 4 5 6 7 8 9 10 11
12)] (list a b c list)) => '(4 8 12 (1 2 3 4 5 6 7 8 9 10 11 12))
(-let (((x &as a b) (list 1 2))
((y &as c d) (list 3 4)))
- (list a b c d x y)) => '(1 2 3 4 (1 2) (3 4)))
+ (list a b c d x y)) => '(1 2 3 4 (1 2) (3 4))
+ (-let (((&hash-or-plist :key) (--doto (make-hash-table)
+ (puthash :key "value" it))))
+ key) => "value"
+ (-let (((&hash-or-plist :key) '(:key "value")))
+ key) => "value")
(defexamples -let*
(-let* (((a . b) (cons 1 2))
