mirror of
https://github.com/fiddlerwoaroof/data-lens.git
synced 2025-11-08 10:16:32 +00:00
feat: extensible lenses, add functionalize method for fset
This commit is contained in:
@ -17,9 +17,9 @@
|
||||
(data-lens.transducers:transducer-lambda
|
||||
((acc next)
|
||||
(fset:with acc next))))
|
||||
(defmethod data-lens:functionalize ((it fset:set))
|
||||
(lambda (key)
|
||||
(nth-value 1 (fset:lookup it key))))
|
||||
(defmethod data-lens:functionalize ((set fset:set))
|
||||
(lambda (it)
|
||||
(fset:contains? set it)))
|
||||
(defmethod data-lens:extract-key ((it fset:set) key)
|
||||
(nth-value 1 (fset:lookup it key)))
|
||||
(defun make-set-lens (item)
|
||||
@ -63,6 +63,11 @@
|
||||
rec))
|
||||
|
||||
|
||||
(defmethod data-lens.transducers.internals:reduce-generic ((map fset:map) (func function) init)
|
||||
(fset:reduce (lambda (acc k v)
|
||||
(funcall func acc (list k v)))
|
||||
map
|
||||
:initial-value init))
|
||||
(defmethod data-lens.transducers.internals:builder-for-input ((map fset:map))
|
||||
(values 'fset-map-builder
|
||||
map))
|
||||
@ -104,7 +109,9 @@
|
||||
m)))
|
||||
(defun make-bag-lens (item)
|
||||
(make-set-lens item))
|
||||
|
||||
(defmethod data-lens.lenses:generic-lens ((rec fset:bag) cb loc)
|
||||
(funcall (funcall (make-set-lens loc)
|
||||
cb)
|
||||
rec))
|
||||
|
||||
|
||||
20
optics.lisp
20
optics.lisp
@ -210,10 +210,26 @@ contain the new value at the location focused by the lens."
|
||||
(defun a-lens (cb)
|
||||
(lambda (foo)
|
||||
(fw.lu:prog1-bind (new (clone foo))
|
||||
(setf (a new)
|
||||
(funcall cb (a foo))))))
|
||||
(setf (a new)
|
||||
(funcall cb (a foo))))))
|
||||
(view 'a-lens
|
||||
(over 'a-lens '1+
|
||||
(set 'a-lens 2
|
||||
(make-instance 'foo :a 1)))) #|
|
||||
==> 3 |#)
|
||||
|
||||
(defgeneric generic-lens (rec cb loc)
|
||||
(:method ((rec hash-table) cb loc)
|
||||
(funcall (funcall (make-hash-table-lens loc)
|
||||
cb)
|
||||
rec))
|
||||
(:method ((rec vector) cb loc)
|
||||
(funcall (funcall (make-list-lens loc)
|
||||
cb)
|
||||
rec)))
|
||||
|
||||
(defun lens (loc)
|
||||
"extensible lens using a multimethod for internal implementation"
|
||||
(lambda (cb)
|
||||
(lambda (rec)
|
||||
(generic-lens rec cb loc))))
|
||||
|
||||
Reference in New Issue
Block a user