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

add identity-lens and 0-arg (lens-compose)

Browse Source
This commit is contained in:
AlexKnauth 2015-05-23 13:17:43 -04:00
parent 6281c27879
commit a81269848b
1 changed files with 16 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
lenses/core.rkt
View File

@ -9,6 +9,7 @@
lens-set lens-set
lens-transform lens-transform
lens-compose lens-compose
identity-lens
lens-struct lens-struct
lens-proc lens-proc
) )
@ -58,6 +59,9 @@
(values (getter v) (values (getter v)
(setter v _))) ; fancy-app (setter v _))) ; fancy-app
(define identity-lens
(values _ identity)) ; fancy-app
(module+ test (module+ test
(define (set-first l v) (define (set-first l v)
(list* v (rest l))) (list* v (rest l)))
@ -65,6 +69,9 @@
(define first-lens (make-lens first set-first)) (define first-lens (make-lens first set-first))
(check-equal? (lens-view first-lens test-list) 1) (check-equal? (lens-view first-lens test-list) 1)
(check-equal? (lens-set first-lens test-list 'a) '(a 2 3)) (check-equal? (lens-set first-lens test-list 'a) '(a 2 3))
(check-equal? (lens-view identity-lens 3) 3)
(check-equal? (lens-set identity-lens 3 4) 4)
(check-equal? (lens-compose) identity-lens)
(define first* (lens-struct first-lens)) (define first* (lens-struct first-lens))
(check-equal? (first* test-list) 1) (check-equal? (first* test-list) 1)
(check-equal? (lens-view first* test-list) 1) (check-equal? (lens-view first* test-list) 1)
@ -114,7 +121,7 @@
(define (second-set l v) (define (second-set l v)
(list* (first l) v (rest (rest l)))) (list* (first l) v (rest (rest l))))
(define second-lens (make-lens second second-set)) (define second-lens (make-lens second second-set))
(define first-of-second-lens (lens-compose2 first-lens second-lens)) (define first-of-second-lens (lens-compose first-lens second-lens))
(define test-alist '((a 1) (b 2) (c 3))) (define test-alist '((a 1) (b 2) (c 3)))
(check-eq? (lens-view first-of-second-lens test-alist) 'b) (check-eq? (lens-view first-of-second-lens test-alist) 'b)
(check-equal? (lens-set first-of-second-lens test-alist 'B) (check-equal? (lens-set first-of-second-lens test-alist 'B)
@ -134,4 +141,11 @@
(check-eqv? (num-append 1) 1)) (check-eqv? (num-append 1) 1))
(define lens-compose (generalize-operator lens-compose2)) (define lens-compose-proc (generalize-operator lens-compose2))
(define lens-compose
(case-lambda
[() identity-lens]
[(v . vs)
(apply lens-compose-proc v vs)]))