fiddlerwoaroof/data-lens
1
0
Fork 0
mirror of https://github.com/fiddlerwoaroof/data-lens.git synced 2025-11-08 10:16:32 +00:00
Code Issues Releases Wiki Activity

feat: allow over to accept multiple functions and compose them

Browse Source
This commit is contained in:
Edward Langley
2023-04-13 09:29:22 -07:00
parent 08302fae40
commit 9c4d29543b
2 changed files with 29 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

27
lens.lisp
View File

@ -291,10 +291,29 @@
seq
:initial-value ()))))
(defun over (fun &key (result-type 'list))
(let ((fun (functionalize fun)))
(lambda (seq)
(map result-type fun seq))))
(defun over (fun &rest funs)
(let* ((fun (functionalize fun))
(rt-pos (position :result-type funs))
(result-type (cond
((null rt-pos) 'list)
((>= (1+ rt-pos)
(length funs))
(error "invalid result-type"))
(t
(elt funs (1+ rt-pos)))))
(funs (if rt-pos
(append (mapcar #'functionalize
(subseq funs 0 rt-pos))
(mapcar #'functionalize
(subseq funs (+ rt-pos 2))))
(mapcar #'functionalize funs)))
(combined-fun (if funs
(apply #'alexandria:compose fun funs)
fun)))
(lambda (seq &rest seqs)
(if seqs
(apply #'map result-type combined-fun seq seqs)
(map result-type combined-fun seq)))))
(defun denest (&key (result-type 'list))
(lambda (seq)

6
t/lens.lisp
View File

@ -250,6 +250,12 @@
(5am:is (equalp #(1 2 3)
(funcall (data-lens:over '1+ :result-type 'vector)
'(0 1 2))))
(5am:is (equalp #(2 3 4)
(funcall (data-lens:over '1+ :result-type 'vector '1+)
'(0 1 2))))
(5am:is (equalp #(2 3 4)
(funcall (data-lens:over '1+ '1+ :result-type 'vector)
'(0 1 2))))
(5am:is (equalp #(1 2 3)
(funcall (data-lens:over '1+ :result-type 'vector)
#(0 1 2)))))