[elpa] externals/dash a87df31 111/316: Merge pull request #269 from magnars/feature/smart-kv-destructuring

[ELPA Syncer]

branch: externals/dash
commit a87df31db9c568bb740738bc5e8e8dec6c1fe7d3
Merge: 0505f5d e52909f
Author: Matus Goljer <dota.keys@gmail.com>
Commit: GitHub <noreply@github.com>

    Merge pull request #269 from magnars/feature/smart-kv-destructuring
    
    Smart kv destructuring
---
 README.md       |  33 +++++++++++++++++
 dash.el         |  78 ++++++++++++++++++++++++++++++++++++++--
 dash.info       | 109 ++++++++++++++++++++++++++++++++++++--------------------
 dash.texi       |  33 +++++++++++++++++
 dev/examples.el |  29 +++++++++++++++
 5 files changed, 242 insertions(+), 40 deletions(-)

diff --git a/README.md b/README.md
index 7fa86c1..1070672 100644
--- a/README.md
+++ b/README.md
@@ -2324,14 +2324,17 @@ Key/value stores:
     (&plist key0 a0 ... keyN aN) - bind value mapped by keyK in the
                                    `source` plist to aK.  If the
                                    value is not found, aK is nil.
+                                   Uses `plist-get` to fetch values.
 
     (&alist key0 a0 ... keyN aN) - bind value mapped by keyK in the
                                    `source` alist to aK.  If the
                                    value is not found, aK is nil.
+                                   Uses `assoc` to fetch values.
 
     (&hash key0 a0 ... keyN aN) - bind value mapped by keyK in the
                                   `source` hash table to aK.  If the
                                   value is not found, aK is nil.
+                                  Uses `gethash` to fetch values.
 
 Further, special keyword &keys supports "inline" matching of
 plist-like key-value pairs, similarly to &keys keyword of
@@ -2342,6 +2345,36 @@ plist-like key-value pairs, similarly to &keys keyword of
 This binds `n` values from the list to a1 ... aN, then interprets
 the cdr as a plist (see key/value matching above).
 
+`a` shorthand notation for kv-destructuring exists which allows the
+patterns be optionally left out and derived from the key name in
+the following fashion:
+
+- a key :foo is converted into `foo` pattern,
+- a key 'bar is converted into `bar` pattern,
+- a key "baz" is converted into `baz` pattern.
+
+That is, the entire value under the key is bound to the derived
+variable without any further destructuring.
+
+This is possible only when the form following the key is not a
+valid pattern (i.e. not a symbol, a cons cell or a vector).
+Otherwise the matching proceeds as usual and in case of an
+invalid spec fails with an error.
+
+Thus the patterns are normalized as follows:
+
+     ;; derive all the missing patterns
+     (&plist :foo 'bar "baz") => (&plist :foo foo 'bar bar "baz" baz)
+
+     ;; we can specify some but not others
+     (&plist :foo 'bar explicit-bar) => (&plist :foo foo 'bar explicit-bar)
+
+     ;; nothing happens, we store :foo in x
+     (&plist :foo x) => (&plist :foo x)
+
+     ;; nothing happens, we match recursively
+     (&plist :foo (a b c)) => (&plist :foo (a b c))
+
 You can name the source using the syntax `symbol` &as `pattern`.
 This syntax works with lists (proper or improper), vectors and
 all types of maps.
diff --git a/dash.el b/dash.el
index a115a43..a9357ca 100644
--- a/dash.el
+++ b/dash.el
@@ -1618,7 +1618,7 @@ SOURCE is a proper or improper list."
         (cond
          ((and (symbolp (car match-form))
                (memq (car match-form) '(&keys &plist &alist &hash)))
-          (dash--match-kv match-form (dash--match-cons-get-cdr skip-cdr 
source)))
+          (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
                               (plist-put props :skip-cdr (1+ skip-cdr))))
@@ -1702,6 +1702,47 @@ is discarded."
         (setq i (1+ i))))
     (-flatten-n 1 (nreverse re))))
 
+(defun dash--match-kv-normalize-match-form (pattern)
+  "Normalize kv PATTERN.
+
+This method normalizes PATTERN to the format expected by
+`dash--match-kv'.  See `-let' for the specification."
+  (let ((normalized (list (car pattern)))
+        (skip nil)
+        (fill-placeholder (make-symbol "--dash-fill-placeholder--")))
+    (-each (apply '-zip (-pad fill-placeholder (cdr pattern) (cddr pattern)))
+      (lambda (pair)
+        (let ((current (car pair))
+              (next (cdr pair)))
+          (if skip
+              (setq skip nil)
+            (if (or (eq fill-placeholder next)
+                    (not (or (and (symbolp next)
+                                  (not (keywordp next))
+                                  (not (eq next t))
+                                  (not (eq next nil)))
+                             (and (consp next)
+                                  (not (eq (car next) 'quote)))
+                             (vectorp next))))
+                (progn
+                  (cond
+                   ((keywordp current)
+                    (push current normalized)
+                    (push (intern (substring (symbol-name current) 1)) 
normalized))
+                   ((stringp current)
+                    (push current normalized)
+                    (push (intern current) normalized))
+                   ((and (consp current)
+                         (eq (car current) 'quote))
+                    (push current normalized)
+                    (push (cadr current) normalized))
+                   (t (error "-let: found key `%s' in kv destructuring but its 
pattern `%s' is invalid and can not be derived from the key" current next)))
+                  (setq skip nil))
+              (push current normalized)
+              (push next normalized)
+              (setq skip t))))))
+    (nreverse normalized)))
+
 (defun dash--match-kv (match-form source)
   "Setup a kv matching environment and call the real matcher.
 
@@ -1774,7 +1815,7 @@ Key-value stores are disambiguated by placing a token 
&plist,
         (cons (list s source)
               (dash--match (cddr match-form) s))))
      ((memq (car match-form) '(&keys &plist &alist &hash))
-      (dash--match-kv match-form source))
+      (dash--match-kv (dash--match-kv-normalize-match-form match-form) source))
      (t (dash--match-cons match-form source))))
    ((vectorp match-form)
     ;; We support the &as binding in vectors too
@@ -1876,14 +1917,17 @@ Key/value stores:
   (&plist key0 a0 ... keyN aN) - bind value mapped by keyK in the
                                  SOURCE plist to aK.  If the
                                  value is not found, aK is nil.
+                                 Uses `plist-get' to fetch values.
 
   (&alist key0 a0 ... keyN aN) - bind value mapped by keyK in the
                                  SOURCE alist to aK.  If the
                                  value is not found, aK is nil.
+                                 Uses `assoc' to fetch values.
 
   (&hash key0 a0 ... keyN aN) - bind value mapped by keyK in the
                                 SOURCE hash table to aK.  If the
                                 value is not found, aK is nil.
+                                Uses `gethash' to fetch values.
 
 Further, special keyword &keys supports \"inline\" matching of
 plist-like key-value pairs, similarly to &keys keyword of
@@ -1894,6 +1938,36 @@ plist-like key-value pairs, similarly to &keys keyword of
 This binds N values from the list to a1 ... aN, then interprets
 the cdr as a plist (see key/value matching above).
 
+A shorthand notation for kv-destructuring exists which allows the
+patterns be optionally left out and derived from the key name in
+the following fashion:
+
+- a key :foo is converted into `foo' pattern,
+- a key 'bar is converted into `bar' pattern,
+- a key \"baz\" is converted into `baz' pattern.
+
+That is, the entire value under the key is bound to the derived
+variable without any further destructuring.
+
+This is possible only when the form following the key is not a
+valid pattern (i.e. not a symbol, a cons cell or a vector).
+Otherwise the matching proceeds as usual and in case of an
+invalid spec fails with an error.
+
+Thus the patterns are normalized as follows:
+
+   ;; derive all the missing patterns
+   (&plist :foo 'bar \"baz\") => (&plist :foo foo 'bar bar \"baz\" baz)
+
+   ;; we can specify some but not others
+   (&plist :foo 'bar explicit-bar) => (&plist :foo foo 'bar explicit-bar)
+
+   ;; nothing happens, we store :foo in x
+   (&plist :foo x) => (&plist :foo x)
+
+   ;; nothing happens, we match recursively
+   (&plist :foo (a b c)) => (&plist :foo (a b c))
+
 You can name the source using the syntax SYMBOL &as PATTERN.
 This syntax works with lists (proper or improper), vectors and
 all types of maps.
diff --git a/dash.info b/dash.info
index 5d10cc8..e92ab33 100644
--- a/dash.info
+++ b/dash.info
@@ -2245,13 +2245,16 @@ control.
      Key/value stores:
 
      (&plist key0 a0 ...  keyN aN) - bind value mapped by keyK in the
-     SOURCE plist to aK. If the value is not found, aK is nil.
+     SOURCE plist to aK. If the value is not found, aK is nil.  Uses
+     ‘plist-get’ to fetch values.
 
      (&alist key0 a0 ...  keyN aN) - bind value mapped by keyK in the
-     SOURCE alist to aK. If the value is not found, aK is nil.
+     SOURCE alist to aK. If the value is not found, aK is nil.  Uses
+     ‘assoc’ to fetch values.
 
      (&hash key0 a0 ...  keyN aN) - bind value mapped by keyK in the
      SOURCE hash table to aK. If the value is not found, aK is nil.
+     Uses ‘gethash’ to fetch values.
 
      Further, special keyword &keys supports "inline" matching of
      plist-like key-value pairs, similarly to &keys keyword of
@@ -2262,6 +2265,36 @@ control.
      This binds N values from the list to a1 ...  aN, then interprets
      the cdr as a plist (see key/value matching above).
 
+     A shorthand notation for kv-destructuring exists which allows the
+     patterns be optionally left out and derived from the key name in
+     the following fashion:
+
+     - a key :foo is converted into ‘foo’ pattern, - a key ’bar is
+     converted into ‘bar’ pattern, - a key "baz" is converted into
+     ‘baz’ pattern.
+
+     That is, the entire value under the key is bound to the derived
+     variable without any further destructuring.
+
+     This is possible only when the form following the key is not a
+     valid pattern (i.e.  not a symbol, a cons cell or a vector).
+     Otherwise the matching proceeds as usual and in case of an
+     invalid spec fails with an error.
+
+     Thus the patterns are normalized as follows:
+
+     ;; derive all the missing patterns (&plist :foo ’bar "baz") =>
+     (&plist :foo foo ’bar bar "baz" baz)
+
+     ;; we can specify some but not others (&plist :foo ’bar
+     explicit-bar) => (&plist :foo foo ’bar explicit-bar)
+
+     ;; nothing happens, we store :foo in x (&plist :foo x) => (&plist
+     :foo x)
+
+     ;; nothing happens, we match recursively (&plist :foo (a b c)) =>
+     (&plist :foo (a b c))
+
      You can name the source using the syntax SYMBOL &as PATTERN.
      This syntax works with lists (proper or improper), vectors and
      all types of maps.
@@ -2976,13 +3009,13 @@ Index
 * -juxt:                                 Function combinators.
                                                             (line  31)
 * -keep:                                 List to list.      (line   8)
-* -lambda:                               Binding.           (line 220)
+* -lambda:                               Binding.           (line 253)
 * -last:                                 Other list operations.
                                                             (line 232)
 * -last-item:                            Other list operations.
                                                             (line 301)
 * -let:                                  Binding.           (line  66)
-* -let*:                                 Binding.           (line 200)
+* -let*:                                 Binding.           (line 233)
 * -list:                                 Other list operations.
                                                             (line 334)
 * -map:                                  Maps.              (line  10)
@@ -3056,7 +3089,7 @@ Index
 * -select-column:                        Sublist selection. (line 199)
 * -select-columns:                       Sublist selection. (line 180)
 * -separate:                             Partitioning.      (line  63)
-* -setq:                                 Binding.           (line 243)
+* -setq:                                 Binding.           (line 276)
 * -slice:                                Sublist selection. (line  86)
 * -snoc:                                 Other list operations.
                                                             (line  42)
@@ -3271,39 +3304,39 @@ Ref: -when-let*71822
 Ref: -if-let72350
 Ref: -if-let*72745
 Ref: -let73362
-Ref: -let*78155
-Ref: -lambda79096
-Ref: -setq79898
-Node: Side-effects80714
-Ref: -each80908
-Ref: -each-while81315
-Ref: -each-indexed81675
-Ref: -dotimes82193
-Ref: -doto82496
-Node: Destructive operations82923
-Ref: !cons83096
-Ref: !cdr83302
-Node: Function combinators83497
-Ref: -partial83771
-Ref: -rpartial84166
-Ref: -juxt84568
-Ref: -compose85000
-Ref: -applify85558
-Ref: -on86005
-Ref: -flip86528
-Ref: -const86840
-Ref: -cut87184
-Ref: -not87670
-Ref: -orfn87980
-Ref: -andfn88414
-Ref: -iteratefn88909
-Ref: -fixfn89612
-Ref: -prodfn91181
-Node: Development92247
-Node: Contribute92596
-Node: Changes93344
-Node: Contributors96343
-Node: Index97967
+Ref: -let*79450
+Ref: -lambda80391
+Ref: -setq81193
+Node: Side-effects82009
+Ref: -each82203
+Ref: -each-while82610
+Ref: -each-indexed82970
+Ref: -dotimes83488
+Ref: -doto83791
+Node: Destructive operations84218
+Ref: !cons84391
+Ref: !cdr84597
+Node: Function combinators84792
+Ref: -partial85066
+Ref: -rpartial85461
+Ref: -juxt85863
+Ref: -compose86295
+Ref: -applify86853
+Ref: -on87300
+Ref: -flip87823
+Ref: -const88135
+Ref: -cut88479
+Ref: -not88965
+Ref: -orfn89275
+Ref: -andfn89709
+Ref: -iteratefn90204
+Ref: -fixfn90907
+Ref: -prodfn92476
+Node: Development93542
+Node: Contribute93891
+Node: Changes94639
+Node: Contributors97638
+Node: Index99262
 
 End Tag Table
 
diff --git a/dash.texi b/dash.texi
index 4fb616d..2243a34 100644
--- a/dash.texi
+++ b/dash.texi
@@ -3564,14 +3564,17 @@ Key/value stores:
     (&plist key0 a0 ... keyN aN) - bind value mapped by keyK in the
                                    @var{source} plist to aK.  If the
                                    value is not found, aK is nil.
+                                   Uses @code{plist-get} to fetch values.
 
     (&alist key0 a0 ... keyN aN) - bind value mapped by keyK in the
                                    @var{source} alist to aK.  If the
                                    value is not found, aK is nil.
+                                   Uses @code{assoc} to fetch values.
 
     (&hash key0 a0 ... keyN aN) - bind value mapped by keyK in the
                                   @var{source} hash table to aK.  If the
                                   value is not found, aK is nil.
+                                  Uses @code{gethash} to fetch values.
 
 Further, special keyword &keys supports "inline" matching of
 plist-like key-value pairs, similarly to &keys keyword of
@@ -3582,6 +3585,36 @@ plist-like key-value pairs, similarly to &keys keyword of
 This binds @var{n} values from the list to a1 ... aN, then interprets
 the cdr as a plist (see key/value matching above).
 
+@var{a} shorthand notation for kv-destructuring exists which allows the
+patterns be optionally left out and derived from the key name in
+the following fashion:
+
+- a key :foo is converted into @code{foo} pattern,
+- a key 'bar is converted into @code{bar} pattern,
+- a key "baz" is converted into @code{baz} pattern.
+
+That is, the entire value under the key is bound to the derived
+variable without any further destructuring.
+
+This is possible only when the form following the key is not a
+valid pattern (i.e. not a symbol, a cons cell or a vector).
+Otherwise the matching proceeds as usual and in case of an
+invalid spec fails with an error.
+
+Thus the patterns are normalized as follows:
+
+     ;; derive all the missing patterns
+     (&plist :foo 'bar "baz") => (&plist :foo foo 'bar bar "baz" baz)
+
+     ;; we can specify some but not others
+     (&plist :foo 'bar explicit-bar) => (&plist :foo foo 'bar explicit-bar)
+
+     ;; nothing happens, we store :foo in x
+     (&plist :foo x) => (&plist :foo x)
+
+     ;; nothing happens, we match recursively
+     (&plist :foo (a b c)) => (&plist :foo (a b c))
+
 You can name the source using the syntax @var{symbol} &as @var{pattern}.
 This syntax works with lists (proper or improper), vectors and
 all types of maps.
diff --git a/dev/examples.el b/dev/examples.el
index bd35559..5fda281 100644
--- a/dev/examples.el
+++ b/dev/examples.el
@@ -1100,6 +1100,35 @@ new list."
     (-let (((_ _ . (&alist 'a a 'c c)) (list 1 2 '(a . b) '(e . f) '(g . h) 
'(c . d)))) (list a c)) => '(b d)
     (-let (((x y (&alist 'a a 'c c)) (list 1 2 '((a . b) (e . f) (g . h) (c . 
d))))) (list x y a c)) => '(1 2 b d)
     (-let (((_ _ . ((&alist 'a a 'c c))) (list 1 2 '((a . b) (e . f) (g . h) 
(c . d))))) (list a c)) => '(b d)
+    ;; auto-derived match forms for kv destructuring
+    ;;; test that we normalize all the supported kv stores
+    (-let (((&plist :foo :bar) (list :foo 1 :bar 2))) (list foo bar)) => '(1 2)
+    (-let (((&alist :foo :bar) (list (cons :foo 1) (cons :bar 2)))) (list foo 
bar)) => '(1 2)
+    (let ((hash (make-hash-table)))
+      (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)
+    ;;; 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)
+    (-let (((&plist :foo x :bar y) (list :foo 1 :bar 2))) (list x y)) => '(1 2)
+    (-let (((&plist :foo (x) :bar [y]) (list :foo (list 1) :bar (vector 2)))) 
(list x y)) => '(1 2)
+    (-let (((&plist 'foo 'bar) (list 'foo 1 'bar 2))) (list foo bar)) => '(1 2)
+    (-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)
+    (-let (((&plist 'foo x 'bar y) (list 'foo 1 'bar 2))) (list x y)) => '(1 2)
+    (-let (((&alist "foo" "bar") (list (cons "foo" 1) (cons "bar" 2)))) (list 
foo bar)) => '(1 2)
+    (-let (((&alist "foo" x "bar") (list (cons "foo" 1) (cons "bar" 2)))) 
(list x bar)) => '(1 2)
+    (-let (((&alist "foo" x "bar" y) (list (cons "foo" 1) (cons "bar" 2)))) 
(list x y)) => '(1 2)
+    (-let (((&alist :a 'b "c") (list (cons :a 1) (cons 'b 2) (cons "c" 3)))) 
(list a b c)) => '(1 2 3)
+    (-let (((&alist 'b :a "c") (list (cons :a 1) (cons 'b 2) (cons "c" 3)))) 
(list a b c)) => '(1 2 3)
+    (-let (((&alist 'b "c" :a) (list (cons :a 1) (cons 'b 2) (cons "c" 3)))) 
(list a b c)) => '(1 2 3)
+    (-let (((&alist "c" 'b :a) (list (cons :a 1) (cons 'b 2) (cons "c" 3)))) 
(list a b c)) => '(1 2 3)
+    (-let (((&alist "c" :a 'b) (list (cons :a 1) (cons 'b 2) (cons "c" 3)))) 
(list a b c)) => '(1 2 3)
+    (-let (((&alist :a "c" 'b) (list (cons :a 1) (cons 'b 2) (cons "c" 3)))) 
(list a b c)) => '(1 2 3)
+    (-let (((&plist 'foo 1) (list 'foo 'bar))) (list foo)) !!> error
+    (-let (((&plist foo :bar) (list :foo :bar))) (list foo)) !!> error
     ;; test the &as form
     (-let (((items &as first . rest) (list 1 2 3))) (list first rest items)) 
=> '(1 (2 3) (1 2 3))
     (-let [(all &as [vect &as a b] bar) (list [1 2] 3)] (list a b bar vect 
all)) => '(1 2 3 [1 2] ([1 2] 3))