Merge pull request #277 from yyoncho/custom-destructoring

Provided option to extend destructoring

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)

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))