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

Merge pull request #210 from AlexKnauth/check-lens-view

Browse Source 
rename check-view etc. to check-lens-view etc.
This commit is contained in:
Jack Firth 2015-09-07 15:42:00 -07:00
commit fe21a59ad2
19 changed files with 126 additions and 117 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lens/private/compound/compose.rkt
View File

@ -11,6 +11,7 @@ require racket/contract
module+ test module+ test
require rackunit require rackunit
racket/set racket/set
"../test-util/test-lens.rkt"
provide provide
contract-out contract-out
@ -40,6 +41,6 @@ module+ test
(define second-lens (make-lens second set-second)) (define second-lens (make-lens second set-second))
(define test-alist '((a 1) (b 2) (c 3))) (define test-alist '((a 1) (b 2) (c 3)))
(define first-of-second-lens (lens-compose first-lens second-lens)) (define first-of-second-lens (lens-compose first-lens second-lens))
(check-equal? (lens-view first-of-second-lens test-alist) 'b) (check-lens-view first-of-second-lens test-alist 'b)
(check-equal? (lens-set first-of-second-lens test-alist 'B) '((a 1) (B 2) (c 3))) (check-lens-set first-of-second-lens test-alist 'B '((a 1) (B 2) (c 3)))
(check-eq? (lens-compose) identity-lens) (check-eq? (lens-compose) identity-lens)

5
lens/private/compound/identity.rkt
View File

@ -8,6 +8,7 @@ require racket/function
module+ test module+ test
require rackunit require rackunit
"../base/main.rkt" "../base/main.rkt"
"../test-util/test-lens.rkt"
provide provide
contract-out contract-out
@ -18,5 +19,5 @@ provide
(make-isomorphism-lens identity identity)) (make-isomorphism-lens identity identity))
(module+ test (module+ test
(check-equal? (lens-view identity-lens 'foo) 'foo) (check-lens-view identity-lens 'foo 'foo)
(check-equal? (lens-set identity-lens 'foo 'bar) 'bar)) (check-lens-set identity-lens 'foo 'bar 'bar))

11
lens/private/compound/join-hash.rkt
View File

@ -12,7 +12,8 @@
(module+ test (module+ test
(require rackunit (require rackunit
"../list/list-ref-take-drop.rkt")) "../list/list-ref-take-drop.rkt"
"../test-util/test-lens.rkt"))
(provide (provide
(contract-out (contract-out
@ -34,8 +35,8 @@
(module+ test (module+ test
(define a-b-lens (lens-join/hash 'b third-lens (define a-b-lens (lens-join/hash 'b third-lens
'a first-lens)) 'a first-lens))
(check-equal? (lens-view a-b-lens '(1 2 3)) (check-lens-view a-b-lens '(1 2 3)
(hash 'a 1 'b 3)) (hash 'a 1 'b 3))
(check-equal? (lens-set a-b-lens '(1 2 3) (hash 'a 100 'b 200)) (check-lens-set a-b-lens '(1 2 3) (hash 'a 100 'b 200)
'(100 2 200))) '(100 2 200)))

9
lens/private/compound/join-list.rkt
View File

@ -9,6 +9,7 @@ require racket/list
module+ test module+ test
require rackunit require rackunit
"../list/list-ref-take-drop.rkt" "../list/list-ref-take-drop.rkt"
"../test-util/test-lens.rkt"
provide provide
contract-out contract-out
@ -28,7 +29,7 @@ provide
(lens-join/list first-lens (lens-join/list first-lens
third-lens third-lens
fifth-lens)) fifth-lens))
(check-equal? (lens-view first-third-fifth-lens '(a b c d e f)) (check-lens-view first-third-fifth-lens '(a b c d e f)
'(a c e)) '(a c e))
(check-equal? (lens-set first-third-fifth-lens '(a b c d e f) '(1 2 3)) (check-lens-set first-third-fifth-lens '(a b c d e f) '(1 2 3)
'(1 b 2 d 3 f))) '(1 b 2 d 3 f)))

9
lens/private/compound/join-string.rkt
View File

@ -11,6 +11,7 @@ require racket/contract
module+ test module+ test
require rackunit require rackunit
"../list/list-ref-take-drop.rkt" "../list/list-ref-take-drop.rkt"
"../test-util/test-lens.rkt"
provide provide
contract-out contract-out
@ -28,8 +29,8 @@ provide
(lens-join/string first-lens (lens-join/string first-lens
third-lens third-lens
fifth-lens)) fifth-lens))
(check-equal? (lens-view string-first-third-fifth-lens '(#\a #\b #\c #\d #\e #\f)) (check-lens-view string-first-third-fifth-lens '(#\a #\b #\c #\d #\e #\f)
"ace") "ace")
(check-pred immutable? (lens-view string-first-third-fifth-lens '(#\a #\b #\c #\d #\e #\f))) (check-pred immutable? (lens-view string-first-third-fifth-lens '(#\a #\b #\c #\d #\e #\f)))
(check-equal? (lens-set string-first-third-fifth-lens '(#\a #\b #\c #\d #\e #\f) "ACE") (check-lens-set string-first-third-fifth-lens '(#\a #\b #\c #\d #\e #\f) "ACE"
'(#\A #\b #\C #\d #\E #\f))) '(#\A #\b #\C #\d #\E #\f)))

7
lens/private/compound/join-vector.rkt
View File

@ -11,6 +11,7 @@ require racket/contract
module+ test module+ test
require rackunit require rackunit
"../list/list-ref-take-drop.rkt" "../list/list-ref-take-drop.rkt"
"../test-util/test-lens.rkt"
provide provide
contract-out contract-out
@ -28,9 +29,9 @@ provide
(lens-join/vector first-lens (lens-join/vector first-lens
third-lens third-lens
fifth-lens)) fifth-lens))
(check-equal? (lens-view vector-first-third-fifth-lens '(a b c d e f)) (check-lens-view vector-first-third-fifth-lens '(a b c d e f)
#(a c e)) #(a c e))
(check-pred immutable? (lens-view vector-first-third-fifth-lens '(a b c d e f))) (check-pred immutable? (lens-view vector-first-third-fifth-lens '(a b c d e f)))
(check-equal? (lens-set vector-first-third-fifth-lens '(a b c d e f) #(1 2 3)) (check-lens-set vector-first-third-fifth-lens '(a b c d e f) #(1 2 3)
'(1 b 2 d 3 f))) '(1 b 2 d 3 f)))

7
lens/private/compound/thrush.rkt
View File

@ -8,7 +8,8 @@
(module+ test (module+ test
(require rackunit (require rackunit
"../list/list-ref-take-drop.rkt")) "../list/list-ref-take-drop.rkt"
"../test-util/test-lens.rkt"))
(provide (provide
(contract-out [lens-thrush (->* () () #:rest (listof lens?) lens?)])) (contract-out [lens-thrush (->* () () #:rest (listof lens?) lens?)]))
@ -26,5 +27,5 @@
(define second-lens (make-lens second set-second)) (define second-lens (make-lens second set-second))
(define test-alist '((a 1) (b 2) (c 3))) (define test-alist '((a 1) (b 2) (c 3)))
(define first-of-second-lens (lens-thrush second-lens first-lens)) (define first-of-second-lens (lens-thrush second-lens first-lens))
(check-equal? (lens-view first-of-second-lens test-alist) 'b) (check-lens-view first-of-second-lens test-alist 'b)
(check-equal? (lens-set first-of-second-lens test-alist 'B) '((a 1) (B 2) (c 3)))) (check-lens-set first-of-second-lens test-alist 'B '((a 1) (B 2) (c 3))))

10
lens/private/hash/pick.rkt
View File

@ -9,7 +9,7 @@
"ref.rkt") "ref.rkt")
(module+ test (module+ test
(require rackunit)) (require rackunit "../test-util/test-lens.rkt"))
(provide (provide
(contract-out (contract-out
@ -24,7 +24,7 @@
(append-map hash-ref-lens-and-key ks))) (append-map hash-ref-lens-and-key ks)))
(module+ test (module+ test
(check-equal? (lens-view (hash-pick-lens 'a 'c) (hash 'a 1 'b 2 'c 3)) (check-lens-view (hash-pick-lens 'a 'c) (hash 'a 1 'b 2 'c 3)
(hash 'a 1 'c 3)) (hash 'a 1 'c 3))
(check-equal? (lens-set (hash-pick-lens 'a 'c) (hash 'a 1 'b 2 'c 3) (hash 'a 4 'c 5)) (check-lens-set (hash-pick-lens 'a 'c) (hash 'a 1 'b 2 'c 3) (hash 'a 4 'c 5)
(hash 'a 4 'b 2 'c 5))) (hash 'a 4 'b 2 'c 5)))

20
lens/private/list/assoc.rkt
View File

@ -15,7 +15,7 @@
"../base/main.rkt") "../base/main.rkt")
(module+ test (module+ test
(require rackunit) (require rackunit "../test-util/test-lens.rkt")
(define assoc-list '((a . 1) (b . 2) (c . 3)))) (define assoc-list '((a . 1) (b . 2) (c . 3))))
@ -45,9 +45,9 @@
(module+ test (module+ test
(define assoc-b-lens (assoc-lens 'b)) (define assoc-b-lens (assoc-lens 'b))
(check-equal? (lens-view assoc-b-lens assoc-list) 2) (check-lens-view assoc-b-lens assoc-list 2)
(check-equal? (lens-set assoc-b-lens assoc-list 200) (check-lens-set assoc-b-lens assoc-list 200
'((a . 1) (b . 200) (c . 3)))) '((a . 1) (b . 200) (c . 3))))
(define (assv-lens assv-key) (define (assv-lens assv-key)
@ -56,9 +56,9 @@
(module+ test (module+ test
(define assv-2-lens (assv-lens 2)) (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-lens-view assv-2-lens assv-list 'b)
(check-equal? (lens-set assv-2-lens assv-list 'FOO) (check-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) (define (assq-lens assq-key)
@ -67,7 +67,7 @@
(module+ test (module+ test
(define assq-a-lens (assq-lens 'a)) (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-lens-view assq-a-lens assq-list 1)
(check-equal? (lens-set assq-a-lens assq-list 100) (check-lens-set assq-a-lens assq-list 100
'((a . 100) (b . 2) (c . 3)))) '((a . 100) (b . 2) (c . 3))))

8
lens/private/list/car-cdr.rkt
View File

@ -22,10 +22,10 @@
(define cdr-lens (make-lens cdr set-cdr)) (define cdr-lens (make-lens cdr set-cdr))
(module+ test (module+ test
(check-view car-lens '(1 . 2) 1) (check-lens-view car-lens '(1 . 2) 1)
(check-set car-lens '(1 . 2) 'a '(a . 2)) (check-lens-set car-lens '(1 . 2) 'a '(a . 2))
(test-lens-laws car-lens '(1 . 2) 'a 'b) (test-lens-laws car-lens '(1 . 2) 'a 'b)
(check-view cdr-lens '(1 . 2) 2) (check-lens-view cdr-lens '(1 . 2) 2)
(check-set cdr-lens '(1 . 2) 'a '(1 . a)) (check-lens-set cdr-lens '(1 . 2) 'a '(1 . a))
(test-lens-laws cdr-lens '(1 . 2) 'a 'b)) (test-lens-laws cdr-lens '(1 . 2) 'a 'b))

30
lens/private/list/list-ref-take-drop.rkt
View File

@ -31,7 +31,7 @@
"car-cdr.rkt") "car-cdr.rkt")
(module+ test (module+ test
(require rackunit)) (require rackunit "../test-util/test-lens.rkt"))
(define (set-take n lst new-head) (define (set-take n lst new-head)
@ -53,8 +53,8 @@
(module+ test (module+ test
(define take2-lens (take-lens 2)) (define take2-lens (take-lens 2))
(check-equal? (lens-view take2-lens '(1 2 3 4 5)) '(1 2)) (check-lens-view take2-lens '(1 2 3 4 5) '(1 2))
(check-equal? (lens-set take2-lens '(1 2 3 4 5) '(a b)) '(a b 3 4 5))) (check-lens-set take2-lens '(1 2 3 4 5) '(a b) '(a b 3 4 5)))
(define (drop-lens n) (define (drop-lens n)
@ -62,8 +62,8 @@
(module+ test (module+ test
(define drop2-lens (drop-lens 2)) (define drop2-lens (drop-lens 2))
(check-equal? (lens-view drop2-lens '(1 2 3 4 5)) '(3 4 5)) (check-lens-view drop2-lens '(1 2 3 4 5) '(3 4 5))
(check-equal? (lens-set drop2-lens '(1 2 3 4 5) '(a b c)) '(1 2 a b c))) (check-lens-set drop2-lens '(1 2 3 4 5) '(a b c) '(1 2 a b c)))
(define (list-ref-lens i) (define (list-ref-lens i)
@ -82,13 +82,13 @@
(module+ test (module+ test
(check-eqv? (lens-view first-lens '(1 2 3 4 5)) 1) (check-lens-view first-lens '(1 2 3 4 5) 1)
(check-eqv? (lens-view second-lens '(1 2 3 4 5)) 2) (check-lens-view second-lens '(1 2 3 4 5) 2)
(check-eqv? (lens-view third-lens '(1 2 3 4 5)) 3) (check-lens-view third-lens '(1 2 3 4 5) 3)
(check-eqv? (lens-view fourth-lens '(1 2 3 4 5)) 4) (check-lens-view fourth-lens '(1 2 3 4 5) 4)
(check-eqv? (lens-view fifth-lens '(1 2 3 4 5)) 5) (check-lens-view fifth-lens '(1 2 3 4 5) 5)
(check-equal? (lens-set first-lens '(1 2 3 4 5) 'a) '(a 2 3 4 5)) (check-lens-set first-lens '(1 2 3 4 5) 'a '(a 2 3 4 5))
(check-equal? (lens-set second-lens '(1 2 3 4 5) 'a) '(1 a 3 4 5)) (check-lens-set second-lens '(1 2 3 4 5) 'a '(1 a 3 4 5))
(check-equal? (lens-set third-lens '(1 2 3 4 5) 'a) '(1 2 a 4 5)) (check-lens-set third-lens '(1 2 3 4 5) 'a '(1 2 a 4 5))
(check-equal? (lens-set fourth-lens '(1 2 3 4 5) 'a) '(1 2 3 a 5)) (check-lens-set fourth-lens '(1 2 3 4 5) 'a '(1 2 3 a 5))
(check-equal? (lens-set fifth-lens '(1 2 3 4 5) 'a) '(1 2 3 4 a))) (check-lens-set fifth-lens '(1 2 3 4 5) 'a '(1 2 3 4 a)))

10
lens/private/list/multi.rkt
View File

@ -7,7 +7,7 @@
"list-ref-take-drop.rkt") "list-ref-take-drop.rkt")
(module+ test (module+ test
(require rackunit)) (require rackunit "../test-util/test-lens.rkt"))
(provide (provide
(contract-out (contract-out
@ -28,7 +28,7 @@
(module+ test (module+ test
(define 1-5-6-lens (list-refs-lens 1 5 6)) (define 1-5-6-lens (list-refs-lens 1 5 6))
(check-equal? (lens-view 1-5-6-lens '(a b c d e f g)) (check-lens-view 1-5-6-lens '(a b c d e f g)
'(b f g)) '(b f g))
(check-equal? (lens-set 1-5-6-lens '(a b c d e f g) '(1 2 3)) (check-lens-set 1-5-6-lens '(a b c d e f g) '(1 2 3)
'(a 1 c d e 2 3))) '(a 1 c d e 2 3)))

22
lens/private/stream.rkt
View File

@ -20,7 +20,10 @@ module+ test
module+ test module+ test
(define-check (check-stream-equal? stream1 stream2) (define-check (check-stream-equal? stream1 stream2)
(equal? (stream->list stream1) (stream->list stream2))) (let ([list1 (stream->list stream1)] [list2 (stream->list stream2)])
(with-check-info
(['actual-list list1] ['expected-list list2])
(check-equal? list1 list2))))
(define (stream-ref-lens i) (define (stream-ref-lens i)
@ -55,8 +58,8 @@ module+ test
(stream-cons v rst))) (stream-cons v rst)))
module+ test module+ test
(check-equal? (lens-view stream-first-lens (stream 'a 'b 'c)) 'a) (check-lens-view stream-first-lens (stream 'a 'b 'c) 'a)
(check-equal? (lens-view (stream-ref-lens 2) (stream 'a 'b 'c)) 'c) (check-lens-view (stream-ref-lens 2) (stream 'a 'b 'c) 'c)
(check-stream-equal? (lens-set stream-first-lens (stream 'a 'b 'c) 1) (check-stream-equal? (lens-set stream-first-lens (stream 'a 'b 'c) 1)
(stream 1 'b 'c)) (stream 1 'b 'c))
(check-stream-equal? (lens-set (stream-ref-lens 2) (stream 'a 'b 'c) 1) (check-stream-equal? (lens-set (stream-ref-lens 2) (stream 'a 'b 'c) 1)
@ -66,10 +69,9 @@ module+ test
(apply lens-thrush (map stream-ref-lens is))) (apply lens-thrush (map stream-ref-lens is)))
module+ test module+ test
(check-equal? (lens-view (stream-ref-nested-lens 1 2 0) (check-lens-view (stream-ref-nested-lens 1 2 0)
(stream 'a (stream 1 2 (stream 'foo 'bar 'baz) 3 4) 'b 'c 'd)) (stream 'a (stream 1 2 (stream 'foo 'bar 'baz) 3 4) 'b 'c 'd)
'foo) 'foo)
(check-stream-equal? (lens-set (stream-ref-nested-lens 1 2 0) (check-lens-set-view (stream-ref-nested-lens 1 2 0)
(stream 'a (stream 1 2 (stream 'foo 'bar 'baz) 3 4) 'b 'c 'd) (stream 'a (stream 1 2 (stream 'foo 'bar 'baz) 3 4) 'b 'c 'd)
'FOO) 'FOO)
(stream 'a (stream 1 2 (stream 'FOO 'bar 'baz) 3 4) 'b 'c 'd))

14
lens/private/string.rkt
View File

@ -16,7 +16,7 @@
"compound/main.rkt") "compound/main.rkt")
(module+ test (module+ test
(require rackunit)) (require rackunit "test-util/test-lens.rkt"))
(define (string-ref-lens i) (define (string-ref-lens i)
@ -33,8 +33,8 @@
(string-ref s j))))) (string-ref s j)))))
(module+ test (module+ test
(check-equal? (lens-view (string-ref-lens 2) "abc") #\c) (check-lens-view (string-ref-lens 2) "abc" #\c)
(check-equal? (lens-set (string-ref-lens 0) "abc" #\A) "Abc")) (check-lens-set (string-ref-lens 0) "abc" #\A "Abc"))
(define (string-pick-lens . is) (define (string-pick-lens . is)
@ -42,7 +42,7 @@
(module+ test (module+ test
(define 1-5-6-lens (string-pick-lens 1 5 6)) (define 1-5-6-lens (string-pick-lens 1 5 6))
(check-equal? (lens-view 1-5-6-lens "abcdefg") (check-lens-view 1-5-6-lens "abcdefg"
"bfg") "bfg")
(check-equal? (lens-set 1-5-6-lens "abcdefg" "BFG") (check-lens-set 1-5-6-lens "abcdefg" "BFG"
"aBcdeFG")) "aBcdeFG"))

4
lens/private/struct/struct.rkt
View File

@ -57,6 +57,6 @@
(module+ test (module+ test
(struct/lens foo (a b c d) #:transparent) (struct/lens foo (a b c d) #:transparent)
(check-view foo-b-lens (foo 1 2 3 4) 2) (check-lens-view foo-b-lens (foo 1 2 3 4) 2)
(check-set foo-c-lens (foo 1 2 3 4) 'a (foo 1 2 'a 4)) (check-lens-set foo-c-lens (foo 1 2 3 4) 'a (foo 1 2 'a 4))
(test-lens-laws foo-a-lens (foo 1 2 3 4) 'a 'b)) (test-lens-laws foo-a-lens (foo 1 2 3 4) 'a 'b))

48
lens/private/test-util/test-lens.rkt
View File

@ -8,40 +8,40 @@
(provide (provide
(contract-out (contract-out
[check-view (-> lens? any/c any/c void?)] [check-lens-view (-> lens? any/c any/c void?)]
[check-set (-> lens? any/c any/c any/c void?)] [check-lens-set (-> lens? any/c any/c any/c void?)]
[check-view-set (-> lens? any/c void?)] [check-lens-view-set (-> lens? any/c void?)]
[check-set-view (-> lens? any/c any/c void?)] [check-lens-set-view (-> lens? any/c any/c void?)]
[check-set-set (-> lens? any/c any/c any/c void?)] [check-lens-set-set (-> lens? any/c any/c any/c void?)]
[test-lens-laws (-> lens? any/c any/c any/c void?)])) [test-lens-laws (-> lens? any/c any/c any/c void?)]))
(define-check (check-view lens target expected-view) (define-check (check-lens-view lens target expected-view)
(check-equal? (lens-view lens target) expected-view)) (check-equal? (lens-view lens target) expected-view))
(define-check (check-set lens target new-view expected-new-target) (define-check (check-lens-set lens target new-view expected-new-target)
(check-equal? (lens-set lens target new-view) expected-new-target)) (check-equal? (lens-set lens target new-view) expected-new-target))
(define-check (check-view-set lens target) (define-check (check-lens-view-set lens target)
(check-equal? (lens-set lens target (lens-view lens target)) (check-lens-set lens target (lens-view lens target)
target target
"setting target's view to its own view not equal? to itself")) "setting target's view to its own view not equal? to itself"))
(define-check (check-set-view lens target new-view) (define-check (check-lens-set-view lens target new-view)
(check-equal? (lens-view lens (lens-set lens target new-view)) (check-lens-view lens (lens-set lens target new-view)
new-view new-view
"view of target after setting it's view not equal? to the set view")) "view of target after setting it's view not equal? to the set view"))
(define-check (check-set-set lens target new-view1 new-view2) (define-check (check-lens-set-set lens target new-view1 new-view2)
(let* ([target* (lens-set lens target new-view1)] (let* ([target* (lens-set lens target new-view1)]
[target** (lens-set lens target* new-view2)]) [target** (lens-set lens target* new-view2)])
(check-equal? (lens-view lens target**) (check-lens-view lens target**
new-view2 new-view2
"view of target after setting it's view twice not equal? to second view"))) "view of target after setting its view twice not equal? to second view")))
(define (test-lens-laws lens test-target test-view1 test-view2) (define (test-lens-laws lens test-target test-view1 test-view2)
(check-view-set lens test-target) (check-lens-view-set lens test-target)
(check-set-view lens test-target test-view1) (check-lens-set-view lens test-target test-view1)
(check-set-view lens test-target test-view2) (check-lens-set-view lens test-target test-view2)
(check-set-set lens test-target test-view1 test-view2)) (check-lens-set-set lens test-target test-view1 test-view2))

10
lens/private/vector/pick.rkt
View File

@ -8,7 +8,7 @@
"ref.rkt") "ref.rkt")
(module+ test (module+ test
(require rackunit)) (require rackunit "../test-util/test-lens.rkt"))
(provide (provide
(contract-out (contract-out
@ -21,7 +21,7 @@
(module+ test (module+ test
(define 1-5-6-lens (vector-pick-lens 1 5 6)) (define 1-5-6-lens (vector-pick-lens 1 5 6))
(check-equal? (lens-view 1-5-6-lens #(a b c d e f g)) (check-lens-view 1-5-6-lens #(a b c d e f g)
#(b f g)) #(b f g))
(check-equal? (lens-set 1-5-6-lens #(a b c d e f g) #(1 2 3)) (check-lens-set 1-5-6-lens #(a b c d e f g) #(1 2 3)
#(a 1 c d e 2 3))) #(a 1 c d e 2 3)))

6
lens/private/vector/ref.rkt
View File

@ -6,7 +6,7 @@
"../util/immutable.rkt") "../util/immutable.rkt")
(module+ test (module+ test
(require rackunit)) (require rackunit "../test-util/test-lens.rkt"))
(provide (provide
(contract-out (contract-out
@ -28,5 +28,5 @@
(vector-ref v j))))) (vector-ref v j)))))
(module+ test (module+ test
(check-equal? (lens-view (vector-ref-lens 0) #(a b c)) 'a) (check-lens-view (vector-ref-lens 0) #(a b c) 'a)
(check-equal? (lens-set (vector-ref-lens 2) #(a b c) "C") #(a b "C"))) (check-lens-set (vector-ref-lens 2) #(a b c) "C" #(a b "C")))

8
unstable/lens/match.rkt
View File

@ -25,10 +25,10 @@
(module+ test (module+ test
(define car-lens (match-lens a (cons a b) (cons a b))) (define car-lens (match-lens a (cons a b) (cons a b)))
(define cdr-lens (match-lens b (cons a b) (cons a b))) (define cdr-lens (match-lens b (cons a b) (cons a b)))
(check-view car-lens (cons 1 2) 1) (check-lens-view car-lens (cons 1 2) 1)
(check-view cdr-lens (cons 1 2) 2) (check-lens-view cdr-lens (cons 1 2) 2)
(check-set car-lens (cons 1 2) 'a (cons 'a 2)) (check-lens-set car-lens (cons 1 2) 'a (cons 'a 2))
(check-set cdr-lens (cons 1 2) 'a (cons 1 'a)) (check-lens-set cdr-lens (cons 1 2) 'a (cons 1 'a))
(test-lens-laws car-lens (cons 1 2) 'a 'b) (test-lens-laws car-lens (cons 1 2) 'a 'b)
(test-lens-laws cdr-lens (cons 1 2) 'a 'b) (test-lens-laws cdr-lens (cons 1 2) 'a 'b)
) )