diff --git a/data-lens+fset.asd b/data-lens+fset.asd new file mode 100644 index 0000000..fcdaeda --- /dev/null +++ b/data-lens+fset.asd @@ -0,0 +1,12 @@ +(in-package :asdf-user) + +(asdf:defsystem #:data-lens+fset + :author "Edward Langley " + :license "Apache v2" + :depends-on (:data-lens + :data-lens/transducers + :fset + :named-readtables) + :serial t + :in-order-to ((test-op (test-op :data-lens/test))) + :components ((:file "data-lens-fset"))) diff --git a/data-lens-fset.lisp b/data-lens-fset.lisp new file mode 100644 index 0000000..88ce727 --- /dev/null +++ b/data-lens-fset.lisp @@ -0,0 +1,110 @@ +(defpackage :fwoar.data-lens-fset + (:use :cl ) + (:export + #:make-seq-lens + #:make-bag-lens + #:make-set-lens)) +(in-package :fwoar.data-lens-fset) + +(named-readtables:in-readtable fset:fset-readtable) + +(defmethod data-lens.transducers.internals:reduce-generic ((set fset:set) (func function) init) + (fset:reduce func set :initial-value init)) +(defmethod data-lens.transducers.internals:builder-for-input ((seq fset:set)) + (values 'fset-set-builder + seq)) +(defmethod data-lens.transducers.internals:stepper ((seq (eql 'fset-set-builder))) + (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:extract-key ((it fset:set) key) + (nth-value 1 (fset:lookup it key))) +(defun make-set-lens (item) + "A lens for updating a set" + (lambda (cb) + (lambda (set) + (data-lens.lenses:fmap (lambda (new) + (fset:with (fset:less set item) new)) + (funcall cb (nth-value 1 (fset:lookup set item))))))) +(defmethod data-lens.lenses:generic-lens ((rec fset:set) cb loc) + (funcall (funcall (make-set-lens loc) + cb) + rec)) + +(defmethod data-lens.transducers.internals:reduce-generic ((seq fset:seq) (func function) init) + (fset:reduce func seq :initial-value init)) +(defmethod data-lens.transducers.internals:builder-for-input ((seq fset:seq)) + (values 'fset-seq-builder + seq)) +(defmethod data-lens.transducers.internals:stepper ((seq (eql 'fset-seq-builder))) + (data-lens.transducers:transducer-lambda + ((acc next) + (fset:with-last acc next)))) +(defmethod data-lens:functionalize ((it fset:seq)) + (lambda (key) + (fset:lookup it key))) +(defmethod data-lens:extract-key ((it fset:seq) key) + (fset:lookup it key)) +(defmethod data-lens.lenses:fmap (function (data fset:seq))) +(defun make-seq-lens (index) + "A lens for updating a sequence" + (check-type index (integer 0)) + (lambda (cb) + (lambda (seq) + (data-lens.lenses:fmap (lambda (new) + (fset:with seq index new)) + (funcall cb (fset:lookup seq index)))))) +(defmethod data-lens.lenses:generic-lens ((rec fset:seq) cb (loc integer)) + (funcall (funcall (make-seq-lens loc) + cb) + rec)) + + +(defmethod data-lens.transducers.internals:builder-for-input ((map fset:map)) + (values 'fset-map-builder + map)) +(defmethod data-lens.transducers.internals:stepper ((map (eql 'fset-map-builder))) + (data-lens.transducers:transducer-lambda + ((acc next) + (destructuring-bind (k v) next + (fset:with acc k v))))) +(defmethod data-lens:functionalize ((it fset:map)) + (lambda (key) + (fset:lookup it key))) +(defmethod data-lens:extract-key ((it fset:map) key) + (fset:lookup it key)) +(defun make-map-lens (key) + (lambda (cb) + (lambda (map) + (data-lens.lenses:fmap (lambda (new) + (fset:with map key new)) + (funcall cb (fset:lookup map key)))))) +(defmethod data-lens.lenses:generic-lens ((rec fset:map) cb loc) + (funcall (funcall (make-map-lens loc) + cb) + rec)) + + +(defmethod data-lens.transducers.internals:builder-for-input ((bag fset:bag)) + (values 'fset-bag-builder + bag)) +(defmethod data-lens.transducers.internals:stepper ((bag (eql 'fset-bag-builder))) + (data-lens.transducers:transducer-lambda + ((acc next) + (:printv (fset:with acc next))))) +(defmethod data-lens:functionalize ((it fset:bag)) + (lambda (key) + (fset:multiplicity it key))) +(defmethod data-lens:extract-key ((it fset:bag) key) + (let ((m (fset:multiplicity it key))) + (values key + 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)) diff --git a/package.lisp b/package.lisp index 0b483b0..661fadf 100644 --- a/package.lisp +++ b/package.lisp @@ -7,7 +7,10 @@ (:shadow :set) (:use :cl) (:export #:over #:set #:view #:make-alist-lens #:make-plist-lens - #:make-hash-table-lens #:make-list-lens)) + #:make-hash-table-lens #:make-list-lens + #:make-lens + #:generic-lens + #:fmap)) (defpackage :data-lens (:use :cl) @@ -21,7 +24,8 @@ #:transform-elt #:denest #:op #:defalias #:<> #:<>1 #:== #:• #:∘ #:suffixp #:functionalize #:inc #:group-by #:keys #:conj #:disj #:delay #:of-type #:transform #:calling* - #:calling #:hash-join #:tap #:x-group)) + #:calling + #:closing)) (defpackage :data-lens.transducers.internals (:use :cl) @@ -38,4 +42,5 @@ #:hash-table-builder #:vector-builder #:list-builder #:collecting #:mv-mapping #:mv-selecting #:hash-table-select #:mv-filtering #:mapcatting #:lazy-sequence - #:compressing-runs #:iota #:repeating #:repeating* #:into)) + #:compressing-runs #:iota #:repeating #:repeating* #:into + #:transducer-lambda)) diff --git a/transducer-protocol.lisp b/transducer-protocol.lisp index 5c8cc38..d03a330 100644 --- a/transducer-protocol.lisp +++ b/transducer-protocol.lisp @@ -22,6 +22,17 @@ (defgeneric init (client)) (defgeneric stepper (client)) +(defmacro transducer-lambda (&body (((two-arg-acc two-arg-next) &body two-arg-body) + &optional (((one-arg-arg) &body one-arg-body) + '((it) it)))) + (alexandria:with-gensyms (arg1 arg2 next-sym-p) + `(lambda (,arg1 &optional (,arg2 nil ,next-sym-p)) + (if ,next-sym-p + (let ((,two-arg-acc ,arg1) + (,two-arg-next ,arg2)) + ,@two-arg-body) + (let ((,one-arg-arg ,arg1)) + ,@one-arg-body))))) (defgeneric unwrap (client obj) (:method (client obj) obj)) (defgeneric builder-for-input (seq)