Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

lots new functions, more tests.

  • Loading branch information...
commit a2dd39e017933a80cf7de9c2fcd837d16c45c348 1 parent eb7cc6c
Nic Ferrier authored

Showing 2 changed files with 170 additions and 12 deletions. Show diff stats Hide diff stats

  1. +67 1 kv-tests.el
  2. +103 11 kv.el
68 kv-tests.el
@@ -13,7 +13,14 @@
13 13 (string-lessp (symbol-name (car a))
14 14 (symbol-name (car b)))))
15 15 '((name1 . value1)
16   - (name2 . value2)))))
  16 + (name2 . value2))))
  17 + (should
  18 + (equal
  19 + (sort '((a . 1)
  20 + (c . 3)) 'kvcmp)
  21 + (sort (kvhash->alist
  22 + (kvalist->hash '((a . 1)(b . 2)(c . 3)))
  23 + (lambda (k v) (and (memq k '(a c)) v))) 'kvcmp))))
17 24
18 25 (ert-deftest kvalist-sort ()
19 26 (should
@@ -58,6 +65,65 @@
58 65 (kvalist-keys->symbols
59 66 '(("a" . 10)(10 . 20)((a b c) . 30))))))
60 67
  68 +(ert-deftest kvassoc= ()
  69 + (should
  70 + (equal
  71 + '("testkey" . "testvalue")
  72 + (kvassoc= "testkey" "testvalue" '(("testkey" . "testvalue"))))))
  73 +
  74 +(ert-deftest kvassoq= ()
  75 + (should
  76 + (equal
  77 + '(testkey . "testvalue")
  78 + (kvassoq= 'testkey "testvalue" '((testkey . "testvalue")))))
  79 + (should
  80 + (equal
  81 + '("testkey" . "testvalue")
  82 + (kvassoq= "testkey" "testvalue" '(("testkey" . "testvalue")))))
  83 + ;; Not sure about this - should we really find strings with symbols?
  84 + (should
  85 + (equal
  86 + '("testkey" . "testvalue")
  87 + (kvassoq= 'testkey "testvalue" '(("testkey" . "testvalue"))))))
  88 +
  89 +(ert-deftest kvalist2-filter ()
  90 + (should
  91 + (equal
  92 + '(((a . 1)(b . 2)))
  93 + (kvalist2-filter
  94 + '(((a . 1)(b . 2))((c . 1)(d . 2)))
  95 + (lambda (alist)
  96 + (or
  97 + (memq 'a (kvalist->keys alist))
  98 + (memq 'b (kvalist->keys alist))))))))
  99 +
  100 +(ert-deftest kvquery->func ()
  101 + "Test the query language."
  102 + (should
  103 + (equal
  104 + '((("a" . 1)("b" . 2))(("c" . 1)("d" . 2)))
  105 + (kvalist2-filter
  106 + '((("a" . 1)("b" . 2))(("c" . 1)("d" . 2)))
  107 + (kvquery->func '(|(= "a" 1)(= "d" 2))))))
  108 + (should
  109 + (equal
  110 + '((("a" . 1)("b" . 2)))
  111 + (kvalist2-filter
  112 + '((("a" . 1)("b" . 2))(("c" . 1)("d" . 2)))
  113 + (kvquery->func '(= "a" 1)))))
  114 + (should
  115 + (equal
  116 + '()
  117 + (kvalist2-filter
  118 + '((("a" . 1)("b" . 2))(("c" . 1)("d" . 2)))
  119 + (kvquery->func '(&(= "a" 1)(= "c" 1))))))
  120 + (should
  121 + (equal
  122 + '((("a" . 1)("b" . 2)))
  123 + (kvalist2-filter
  124 + '((("a" . 1)("b" . 2))(("c" . 1)("d" . 2)))
  125 + (kvquery->func '(&(= "a" 1)(= "b" 2)))))))
  126 +
61 127 (ert-deftest kvdotassoc ()
62 128 (should
63 129 (equal
114 kv.el
@@ -4,7 +4,7 @@
4 4
5 5 ;; Author: Nic Ferrier <nferrier@ferrier.me.uk>
6 6 ;; Keywords: lisp
7   -;; Version: 0.0.6
  7 +;; Version: 0.0.7
8 8 ;; Maintainer: Nic Ferrier <nferrier@ferrier.me.uk>
9 9 ;; Created: 7th September 2012
10 10
@@ -44,17 +44,81 @@ HASH-TABLE-ARGS are passed to the hash-table creation."
44 44 alist)
45 45 table))
46 46
47   -(defun kvhash->alist (hash)
48   - "Convert HASH to an ALIST."
  47 +(defun kvhash->alist (hash &optional func)
  48 + "Convert HASH to an ALIST.
  49 +
  50 +Optionally filter through FUNC, only non-nil values returned from
  51 +FUNC are stored as the resulting value against the converted
  52 +key."
49 53 (when hash
50 54 (let (store)
51   - (maphash
52   - (lambda (key value)
53   - (setq
54   - store
55   - (append (list (cons key value)) store)))
56   - hash)
57   - store)))
  55 + (maphash
  56 + (lambda (key value)
  57 + (when key
  58 + (if (and (functionp func))
  59 + (let ((res (funcall func key value)))
  60 + (when res
  61 + (setq store (acons key res store))))
  62 + ;; else no filtering, just return
  63 + (setq store (acons key value store)))))
  64 + hash)
  65 + store)))
  66 +
  67 +(defun kvassoc= (key value alist)
  68 + "Is the value assocd to KEY in ALIST equal to VALUE?
  69 +
  70 +Returns the value looked up by KEY that passes, so normally:
  71 +
  72 + KEY . VALUE
  73 +"
  74 + (let ((v (assoc key alist)))
  75 + (and v (equal (cdr v) value) v)))
  76 +
  77 +(defun kvassoq= (key value alist)
  78 + "Test the VALUE with the value bound to KEY in ALIST.
  79 +
  80 +The lookup mechanism is to ensure the key is a symbol and then
  81 +use assq. Hence the name of the function being a mix of assoc
  82 +and assq.
  83 +
  84 +Returns the value looked up by KEY that passes, so normally:
  85 +
  86 + KEY . VALUE
  87 +"
  88 + (let ((v (or
  89 + (assq (if (symbolp key) key (intern key)) alist)
  90 + (or (assoc key alist)
  91 + ;; not sure about this behaviour... see test
  92 + (assoc (symbol-name key) alist)))))
  93 + (and v (equal (cdr v) value) v)))
  94 +
  95 +(defun* kvquery->func (query &key (equal-func 'kvassoc))
  96 + "Turn a simple QUERY expression into a filter function.
  97 +
  98 +EQUAL-FUNC is the function that implements the equality
  99 +predicate."
  100 + (flet ((query-parse (query)
  101 + (let ((part (car query))
  102 + (rest (cdr query)))
  103 + (cond
  104 + ((eq part '|)
  105 + (cons 'or
  106 + (loop for i in rest
  107 + collect (query-parse i))))
  108 + ((eq part '&)
  109 + (cons 'and
  110 + (loop for i in rest
  111 + collect (query-parse i))))
  112 + ((eq part '=)
  113 + (destructuring-bind (field value) rest
  114 + (list equal-func field value (quote record))))))))
  115 + (eval `(lambda (record) ,(query-parse query)))))
  116 +
  117 +(defun kvplist2get (plist2 keyword value)
  118 + "Get the plist with KEYWORD / VALUE from the list of plists."
  119 + (loop for plist in plist2
  120 + if (equal (plist-get keyword) value)
  121 + return plist))
58 122
59 123 (defun kvalist->plist (alist)
60 124 "Convert an alist to a plist."
@@ -145,6 +209,17 @@ KEYS must actually be :-less symbols.
145 209 CAR-KEY is the key of each alist to use as the resulting key and
146 210 CDR-KEY is the key of each alist to user as the resulting cdr.
147 211
  212 +For example, if CAR-KEY is `email' and CDR-KEY is `name' the
  213 +records:
  214 +
  215 + '((user . \"nic\")(name . \"Nic\")(email . \"nic@domain\")
  216 + (user . \"jim\")(name . \"Jim\")(email . \"jim@domain\"))
  217 +
  218 +could be reduced to:
  219 +
  220 + '((\"nic@domain\" . \"Nic\")
  221 + (\"jim@domain\" . \"Jic\"))
  222 +
148 223 If PROPER is `t' then the alist is a list of proper lists, not
149 224 cons cells."
150 225 (loop for alist in alist2
@@ -166,6 +241,16 @@ cons cells."
166 241 "Convert the keys of ALIST into symbols."
167 242 (kvalist-keys->* alist (lambda (key) (intern (format "%s" key)))))
168 243
  244 +(defun kvalist2-filter (alist2 fn)
  245 + "Filter the list of alists with FN."
  246 + (let (value)
  247 + (loop for rec in alist2
  248 + do (setq value (funcall fn rec))
  249 + if value
  250 + collect rec)))
  251 +
  252 +(defun kvidentity (a b)
  253 + (cons a b))
169 254
170 255 (defun kvcmp (a b)
171 256 "Do a comparison of the two values using printable syntax.
@@ -174,6 +259,10 @@ Use this as the function to pass to `sort'."
174 259 (string-lessp (if a (format "%S" a) "")
175 260 (if b (format "%S" b) "")))
176 261
  262 +(defun kvqsort (lst)
  263 + "Do a sort using `kvcmp'."
  264 + (sort lst 'kvcmp))
  265 +
177 266 (defun kvdotassoc-fn (expr table func)
178 267 "Use the dotted EXPR to access deeply nested data in TABLE.
179 268
@@ -220,7 +309,9 @@ FUNC is some sort of `assoc' like function."
220 309 (defalias 'dotassq 'kvdotassq)
221 310
222 311 (defmacro kvmap-bind (args sexp seq)
223   - "A hybrid of `destructuring-bind' and `mapcar'
  312 + "Bind ARGS to successive elements of SEQ and eval SEXP.
  313 +
  314 +A hybrid of `destructuring-bind' and `mapcar'
224 315 ARGS shall be of the form used with `destructuring-bind'
225 316
226 317 Unlike most other mapping forms this is a macro intended to be
@@ -233,6 +324,7 @@ SEXP will describe the structure desired."
233 324 (destructuring-bind ,args ,entry ,sexp))
234 325 ,seq)))
235 326
  327 +
236 328 (defalias 'map-bind 'kvmap-bind)
237 329
238 330 (provide 'kv)

0 comments on commit a2dd39e

Please sign in to comment.
Something went wrong with that request. Please try again.