Add some useful utilities and an example

README.org

@@ -0,0 +1,23 @@
+* Intro
+
+This library provides a language for expressing data manipulations as
+the composition of more primitive operations.
+
+#+BEGIN_SRC lisp
+  DATA-LENS> (funcall (on (compress-runs :collector 'combine-matching-lists)
+                          (alexandria:compose 
+                           (over (juxt (element 0)
+                                       'identity))
+                           (sorted 'string<)))
+                      '("January"   "February" "March"    "April"
+                        "May"       "June"     "July"     "August"
+                        "September" "October"  "November" "December"))
+  #| ==> ((#\A "April" "August") 
+          (#\D "December")
+          (#\F "February")
+          (#\J "January" "July" "June")
+          (#\M "March" "May")
+          (#\N "November")
+          (#\O "October")
+          (#\S "September")) |#
+#+END_SRC

lens.lisp

@@ -3,7 +3,12 @@
   (:export #:regex-match #:include #:exclude #:pick
            #:snapshot-to-vector #:vector-to-lt #:key-transform
            #:combine #:derive #:cumsum #:over #:on #:shortcut
-           #:defun-ct))
+           #:defun-ct
+           #:key
+           #:extract-key
+           #:element
+           #:let-fn
+           #:juxt))
 (in-package :data-lens)
 
 (defmacro shortcut (name function &body bound-args)
@@ -16,6 +21,68 @@
      (defun ,name ,args
        ,@body)))
 
+(defmacro let-fn ((&rest bindings) &body body)
+  (let ((binding-forms (mapcar (lambda (form)
+                                 `(,(car form) ,(cadr form)
+                                    (funcall ,@(cddr form) ,@(cadr form))))
+                               bindings)))
+    `(labels ,binding-forms
+       ,@body)))
+
+(defgeneric extract-key (map key)
+  (:method ((map hash-table) key)
+    (gethash key map))
+  (:method ((map list) key)
+    (typecase (car map)
+      (cons (cdr (assoc key map :test 'equal)))
+      (t (loop for (a-key . value) on map by #'cddr
+            when (equal key a-key) do
+              (return (car value)))))))
+
+(defun-ct deduplicate (&optional (test 'eql))
+  (lambda (it)
+    (remove-duplicates it :test test)))
+
+(defun cons-new (&key (test 'eql) (key 'identity))
+  (lambda (acc next)
+    (if (and acc
+             (funcall test
+                      (funcall key (car acc))
+                      (funcall key next)))
+        acc
+        (cons next acc))))
+
+(defun combine-matching-lists (&key (test 'eql) &allow-other-keys)
+  (lambda (acc next)
+    (if (and acc
+             (funcall test (caar acc) (car next)))
+        (cons (cons (caar acc)
+                    (append (cdar acc)
+                            (cdr next)))
+              (cdr acc))
+        (cons next acc))))
+
+(defun-ct compress-runs (&key (collector 'cons-new) (test 'eql) (key 'identity))
+  (lambda (it)
+    (nreverse
+     (reduce (funcall collector :test test :key key)
+             it
+             :initial-value ()))))
+
+(defun-ct sorted (comparator &rest r &key key)
+  (declare (ignore key))
+  (lambda (it)
+    (apply #'sort (copy-seq it) comparator r)))
+
+(defun-ct element (num)
+  (lambda (it)
+    (elt it num)))
+
+(defun-ct key (key)
+  (lambda (map)
+    (declare (dynamic-extent map))
+    (extract-key map key)))
+
 (defun-ct regex-match (regex)
   (lambda (data)
     (cl-ppcre:scan-to-strings regex data)))
@@ -38,7 +105,7 @@
       (funcall key-set
                (funcall fun key-val)))))
 
-(defun-ct combine (fun1 fun2)
+(defun-ct juxt (fun1 fun2)
   (lambda (item)
     (list (funcall fun1 item)
           (funcall fun2 item))))