Skip to content

Commit

Permalink
feat: add fset integration in system :data-lens+fset
Browse files Browse the repository at this point in the history
  • Loading branch information
fiddlerwoaroof committed Aug 12, 2024
1 parent f10b94f commit d6aef4f
Show file tree
Hide file tree
Showing 4 changed files with 141 additions and 3 deletions.
12 changes: 12 additions & 0 deletions data-lens+fset.asd
Original file line number Diff line number Diff line change
@@ -0,0 +1,12 @@
(in-package :asdf-user)

(asdf:defsystem #:data-lens+fset
:author "Edward Langley <[email protected]>"
: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")))
110 changes: 110 additions & 0 deletions data-lens-fset.lisp
Original file line number Diff line number Diff line change
@@ -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))
11 changes: 8 additions & 3 deletions package.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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)
Expand All @@ -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))
11 changes: 11 additions & 0 deletions transducer-protocol.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down

0 comments on commit d6aef4f

Please sign in to comment.