lots new functions, more tests.

2 files changed, 170 insertions, 12 deletions

diff --git a/kv-tests.el b/kv-tests.el
index 5c5d8f2..f00071b 100644
--- a/kv-tests.el
+++ b/kv-tests.el
@@ -13,7 +13,14 @@
        (string-lessp (symbol-name (car a))
                      (symbol-name (car b)))))
     '((name1 . value1)
-      (name2 . value2)))))
+      (name2 . value2))))
+  (should
+   (equal
+    (sort '((a . 1)
+            (c . 3)) 'kvcmp)
+    (sort (kvhash->alist
+           (kvalist->hash '((a . 1)(b . 2)(c . 3)))
+           (lambda (k v) (and (memq k '(a c)) v))) 'kvcmp))))
 
 (ert-deftest kvalist-sort ()
   (should
@@ -58,6 +65,65 @@
     (kvalist-keys->symbols
      '(("a" . 10)(10 . 20)((a b c) . 30))))))
 
+(ert-deftest kvassoc= ()
+  (should
+   (equal
+    '("testkey" . "testvalue")
+    (kvassoc= "testkey" "testvalue" '(("testkey" . "testvalue"))))))
+
+(ert-deftest kvassoq= ()
+  (should
+   (equal
+    '(testkey . "testvalue")
+    (kvassoq= 'testkey "testvalue" '((testkey . "testvalue")))))
+  (should
+   (equal
+    '("testkey" . "testvalue")
+    (kvassoq= "testkey" "testvalue" '(("testkey" . "testvalue")))))
+  ;; Not sure about this - should we really find strings with symbols?
+  (should
+   (equal
+    '("testkey" . "testvalue")
+    (kvassoq= 'testkey "testvalue" '(("testkey" . "testvalue"))))))
+
+(ert-deftest kvalist2-filter ()
+  (should
+   (equal
+    '(((a . 1)(b . 2)))
+    (kvalist2-filter
+     '(((a . 1)(b . 2))((c . 1)(d . 2)))
+     (lambda (alist)
+       (or
+        (memq 'a (kvalist->keys alist))
+        (memq 'b (kvalist->keys alist))))))))
+
+(ert-deftest kvquery->func ()
+  "Test the query language."
+  (should
+   (equal
+    '((("a" . 1)("b" . 2))(("c" . 1)("d" . 2)))
+    (kvalist2-filter
+     '((("a" . 1)("b" . 2))(("c" . 1)("d" . 2)))
+     (kvquery->func '(|(= "a" 1)(= "d" 2))))))
+  (should
+   (equal
+    '((("a" . 1)("b" . 2)))
+    (kvalist2-filter
+     '((("a" . 1)("b" . 2))(("c" . 1)("d" . 2)))
+     (kvquery->func '(= "a" 1)))))
+  (should
+   (equal
+    '()
+    (kvalist2-filter
+     '((("a" . 1)("b" . 2))(("c" . 1)("d" . 2)))
+     (kvquery->func '(&(= "a" 1)(= "c" 1))))))
+  (should
+   (equal
+    '((("a" . 1)("b" . 2)))
+    (kvalist2-filter
+     '((("a" . 1)("b" . 2))(("c" . 1)("d" . 2)))
+     (kvquery->func '(&(= "a" 1)(= "b" 2)))))))
+
 (ert-deftest kvdotassoc ()
   (should
    (equal
diff --git a/kv.el b/kv.el
index 9fd38fe..e567e11 100644
--- a/kv.el
+++ b/kv.el
@@ -4,7 +4,7 @@
 
 ;; Author: Nic Ferrier <nferrier@ferrier.me.uk>
 ;; Keywords: lisp
-;; Version: 0.0.6
+;; Version: 0.0.7
 ;; Maintainer: Nic Ferrier <nferrier@ferrier.me.uk>
 ;; Created: 7th September 2012
 
@@ -44,17 +44,81 @@ HASH-TABLE-ARGS are passed to the hash-table creation."
      alist)
     table))
 
-(defun kvhash->alist (hash)
-  "Convert HASH to an ALIST."
+(defun kvhash->alist (hash &optional func)
+  "Convert HASH to an ALIST.
+
+Optionally filter through FUNC, only non-nil values returned from
+FUNC are stored as the resulting value against the converted
+key."
   (when hash
     (let (store)
-    (maphash
-     (lambda (key value)
-       (setq
-        store
-        (append (list (cons key value)) store)))
-     hash)
-    store)))
+      (maphash
+       (lambda (key value)
+         (when key
+           (if (and (functionp func))
+               (let ((res (funcall func key value)))
+                 (when res
+                   (setq store (acons key res store))))
+               ;; else no filtering, just return
+               (setq store (acons key value store)))))
+       hash)
+      store)))
+
+(defun kvassoc= (key value alist)
+  "Is the value assocd to KEY in ALIST equal to VALUE?
+
+Returns the value looked up by KEY that passes, so normally:
+
+  KEY . VALUE
+"
+  (let ((v (assoc key alist)))
+    (and v (equal (cdr v) value) v)))
+
+(defun kvassoq= (key value alist)
+  "Test the VALUE with the value bound to KEY in ALIST.
+
+The lookup mechanism is to ensure the key is a symbol and then
+use assq.  Hence the name of the function being a mix of assoc
+and assq.
+
+Returns the value looked up by KEY that passes, so normally:
+
+  KEY . VALUE
+"
+  (let ((v (or
+            (assq (if (symbolp key) key (intern key)) alist)
+            (or (assoc key alist)
+                ;; not sure about this behaviour... see test
+                (assoc (symbol-name key) alist)))))
+    (and v (equal (cdr v) value) v)))
+
+(defun* kvquery->func (query &key (equal-func 'kvassoc))
+  "Turn a simple QUERY expression into a filter function.
+
+EQUAL-FUNC is the function that implements the equality
+predicate."
+  (flet ((query-parse (query)
+           (let ((part (car query))
+                 (rest (cdr query)))
+             (cond
+               ((eq part '|)
+                (cons 'or
+                      (loop for i in rest
+                         collect (query-parse i))))
+               ((eq part '&)
+                (cons 'and
+                      (loop for i in rest
+                         collect (query-parse i))))
+               ((eq part '=)
+                (destructuring-bind (field value) rest
+                  (list equal-func field value (quote record))))))))
+    (eval `(lambda (record) ,(query-parse query)))))
+
+(defun kvplist2get (plist2 keyword value)
+  "Get the plist with KEYWORD / VALUE from the list of plists."
+  (loop for plist in plist2
+       if (equal (plist-get keyword) value)
+       return plist))
 
 (defun kvalist->plist (alist)
   "Convert an alist to a plist."
@@ -145,6 +209,17 @@ KEYS must actually be :-less symbols.
 CAR-KEY is the key of each alist to use as the resulting key and
 CDR-KEY is the key of each alist to user as the resulting cdr.
 
+For example, if CAR-KEY is `email' and CDR-KEY is `name' the
+records:
+
+  '((user . \"nic\")(name . \"Nic\")(email . \"nic@domain\")
+    (user . \"jim\")(name . \"Jim\")(email . \"jim@domain\"))
+
+could be reduced to:
+
+  '((\"nic@domain\" . \"Nic\")
+    (\"jim@domain\" . \"Jic\"))
+
 If PROPER is `t' then the alist is a list of proper lists, not
 cons cells."
   (loop for alist in alist2
@@ -166,6 +241,16 @@ cons cells."
   "Convert the keys of ALIST into symbols."
   (kvalist-keys->* alist (lambda (key) (intern (format "%s" key)))))
 
+(defun kvalist2-filter (alist2 fn)
+  "Filter the list of alists with FN."
+  (let (value)
+    (loop for rec in alist2
+       do (setq value (funcall fn rec))
+       if value
+       collect rec)))
+
+(defun kvidentity (a b)
+  (cons a b))
 
 (defun kvcmp (a b)
   "Do a comparison of the two values using printable syntax.
@@ -174,6 +259,10 @@ Use this as the function to pass to `sort'."
   (string-lessp (if a (format "%S" a) "")
                 (if b (format "%S" b) "")))
 
+(defun kvqsort (lst)
+  "Do a sort using `kvcmp'."
+  (sort lst 'kvcmp))
+
 (defun kvdotassoc-fn (expr table func)
   "Use the dotted EXPR to access deeply nested data in TABLE.
 
@@ -220,7 +309,9 @@ FUNC is some sort of `assoc' like function."
 (defalias 'dotassq 'kvdotassq)
 
 (defmacro kvmap-bind (args sexp seq)
-  "A hybrid of `destructuring-bind' and `mapcar'
+  "Bind ARGS to successive elements of SEQ and eval SEXP.
+
+A hybrid of `destructuring-bind' and `mapcar'
 ARGS shall be of the form used with `destructuring-bind'
 
 Unlike most other mapping forms this is a macro intended to be
@@ -233,6 +324,7 @@ SEXP will describe the structure desired."
                (destructuring-bind ,args ,entry ,sexp))
              ,seq)))
 
+
 (defalias 'map-bind 'kvmap-bind)
 
 (provide 'kv)