suzanne.soy/lens
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix assoc-lens to work with pairs

Browse Source 
fixes https://github.com/jackfirth/lenses/issues/24
This commit is contained in:
AlexKnauth 2015-07-05 03:05:21 -04:00
parent 8ddeced9bd
commit 3556e63551
1 changed files with 15 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
lenses/list/assoc.rkt
View File

@ -17,15 +17,15 @@
(define (assoc-set assoc-list key value #:is-equal? [equal? equal?])
(define (set-assoc-pair assoc-pair)
(if (equal? (first assoc-pair) key)
(list (first assoc-pair) value)
(if (equal? (car assoc-pair) key)
(cons (car assoc-pair) value)
assoc-pair))
(map set-assoc-pair assoc-list))
(module+ test
(define assoc-list '((a 1) (b 2) (c 3)))
(check-equal? (assoc-swap assoc-list '(b 2) '(FOO BAR))
'((a 1) (FOO BAR) (c 3))))
(define assoc-list '((a . 1) (b . 2) (c . 3)))
(check-equal? (assoc-swap assoc-list '(b . 2) '(FOO . BAR))
'((a . 1) (FOO . BAR) (c . 3))))
(define ((assoc-lens key #:is-equal? [equal? equal?]) assoc-list)
@ -33,8 +33,8 @@
(define (assoc-lens-set v)
(if assoc-pair
(assoc-set assoc-list key v #:is-equal? equal?)
(append assoc-list (list (list key v)))))
(values (and assoc-pair (second assoc-pair))
(append assoc-list (list (cons key v)))))
(values (and assoc-pair (cdr assoc-pair))
assoc-lens-set))
(module+ test
@ -42,15 +42,15 @@
(define assoc-d-lens (assoc-lens 'd))
(check-equal? (lens-view assoc-a-lens assoc-list) 1)
(check-equal? (lens-set assoc-a-lens assoc-list 100)
'((a 100) (b 2) (c 3)))
'((a . 100) (b . 2) (c . 3)))
(check-false (lens-view assoc-d-lens assoc-list))
(check-equal? (lens-set assoc-d-lens assoc-list 4)
'((a 1) (b 2) (c 3) (d 4)))
'((a . 1) (b . 2) (c . 3) (d . 4)))
(define assoc-foo-lens (assoc-lens "foo"))
(define assoc-str '(("bar" 1) ("foo" 2) ("baz" 3)))
(define assoc-str '(("bar" . 1) ("foo" . 2) ("baz" . 3)))
(check-equal? (lens-view assoc-foo-lens assoc-str) 2)
(check-equal? (lens-set assoc-foo-lens assoc-str 100)
'(("bar" 1) ("foo" 100) ("baz" 3))))
'(("bar" . 1) ("foo" . 100) ("baz" . 3))))
(define (assv-lens assv-key)
@ -58,10 +58,10 @@
(module+ test
(define assv-2-lens (assv-lens 2))
(define assv-list '((1 a) (2 b) (3 c)))
(define assv-list '((1 . a) (2 . b) (3 . c)))
(check-eq? (lens-view assv-2-lens assv-list) 'b)
(check-equal? (lens-set assv-2-lens assv-list 'FOO)
'((1 a) (2 FOO) (3 c))))
'((1 . a) (2 . FOO) (3 . c))))
(define (assq-lens assq-key)
@ -69,8 +69,8 @@
(module+ test
(define assq-a-lens (assq-lens 'a))
(define assq-list '((a 1) (b 2) (c 3)))
(define assq-list '((a . 1) (b . 2) (c . 3)))
(check-eqv? (lens-view assq-a-lens assq-list) 1)
(check-equal? (lens-set assq-a-lens assq-list 100)
'((a 100) (b 2) (c 3))))
'((a . 100) (b . 2) (c . 3))))