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

Add list lens tests

Browse Source
This commit is contained in:
JackFirth 2015-02-22 18:51:12 -08:00
parent b01fe1f6b6
commit 358377db97
1 changed files with 40 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
lenses/list.rkt
View File

@ -1,5 +1,8 @@
#lang racket
(require rackunit
"core.rkt")
(provide list-lens
first-lens
second-lens
@ -29,6 +32,30 @@
(define fourth-lens (list-lens 3))
(define fifth-lens (list-lens 4))
(module+ test
(check-eqv? (lens-view first-lens '(1 2 3 4 5)) 1)
(check-eqv? (lens-view second-lens '(1 2 3 4 5)) 2)
(check-eqv? (lens-view third-lens '(1 2 3 4 5)) 3)
(check-eqv? (lens-view fourth-lens '(1 2 3 4 5)) 4)
(check-eqv? (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-equal? (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-equal? (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)))
(define (assoc-swap assoc-list old-assoc-pair new-assoc-pair #:is-equal? [equal? equal?])
(define (swap-assoc-pair assoc-pair)
(if (equal? assoc-pair old-assoc-pair)
new-assoc-pair
assoc-pair))
(map swap-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-lens assoc-key #:is-equal? [equal? equal?]) assoc-list)
(define assoc-pair (assoc assoc-key assoc-list equal?))
(define (assoc-set new-assoc-pair)
@ -37,12 +64,11 @@
(append assoc-list new-assoc-pair)))
(values assoc-pair assoc-set))
(define (assoc-swap assoc-list old-assoc-pair new-assoc-pair #:is-equal? [equal? equal?])
(define (swap-assoc-pair assoc-pair)
(if (equal? assoc-pair old-assoc-pair)
new-assoc-pair
assoc-pair))
(map swap-assoc-pair assoc-list))
(module+ test
(define assoc-a-lens (assoc-lens 'a))
(check-equal? (lens-view assoc-a-lens assoc-list) '(a 1))
(check-equal? (lens-set assoc-a-lens assoc-list '(FOO BAR))
'((FOO BAR) (b 2) (c 3))))
(define (assv-lens assv-key)
(assoc-lens assv-key #:is-equal? eqv?))
@ -56,4 +82,11 @@
(if assf-pair
(assoc-swap assoc-list assf-pair new-assf-pair #:is-equal? eq?)
(append assoc-list new-assf-pair)))
(values assf-pair assf-set))
(values assf-pair assf-set))
(module+ test
(define assf>10-lens (assf-lens (λ (v) (> v 10))))
(define assf-list '((1 a) (10 b) (100 c)))
(check-equal? (lens-view assf>10-lens assf-list) '(100 c))
(check-equal? (lens-set assf>10-lens assf-list '(FOO BAR))
'((1 a) (10 b) (FOO BAR))))