diff --git a/README.org b/README.org new file mode 100644 index 0000000..f5cb2dc --- /dev/null +++ b/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 diff --git a/lens.lisp b/lens.lisp index 3cdc0f9..46c4989 100644 --- a/lens.lisp +++ b/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))))