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

Merge pull request #183 from jackfirth/improve-test-coverage

Browse Source 
Improve test coverage
This commit is contained in:
Jack Firth 2015-08-24 14:52:52 -07:00
commit ccec34bf3c
4 changed files with 120 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
info.rkt
View File

@ -27,43 +27,43 @@
(define test-omit-paths
'("info.rkt"
"lens/base/base.scrbl"
"lens/base/contract.scrbl"
"lens/base/laws.scrbl"
"lens/base/main.scrbl"
"lens/base/transform.scrbl"
"lens/base/view-set.scrbl"
"lens/compound/compose.scrbl"
"lens/compound/join-hash.scrbl"
"lens/compound/join-list.scrbl"
"lens/compound/join-string.scrbl"
"lens/compound/join-vector.scrbl"
"lens/compound/main.scrbl"
"lens/compound/thrush.scrbl"
"lens/doc-util"
"lens/hash/main.scrbl"
"lens/hash/nested.scrbl"
"lens/hash/pick.scrbl"
"lens/hash/ref.scrbl"
"lens/list/assoc.scrbl"
"lens/list/car-cdr.scrbl"
"lens/list/list-ref-take-drop.scrbl"
"lens/list/main.scrbl"
"lens/list/multi.scrbl"
"lens/struct/field.scrbl"
"lens/struct/main.scrbl"
"lens/struct/struct.scrbl"
"lens/test-util"
"lens/vector/main.scrbl"
"lens/vector/nested.scrbl"
"lens/vector/pick.scrbl"
"lens/vector/ref.scrbl"
"lens/private/base/base.scrbl"
"lens/private/base/contract.scrbl"
"lens/private/base/laws.scrbl"
"lens/private/base/main.scrbl"
"lens/private/base/transform.scrbl"
"lens/private/base/view-set.scrbl"
"lens/private/compound/compose.scrbl"
"lens/private/compound/join-hash.scrbl"
"lens/private/compound/join-list.scrbl"
"lens/private/compound/join-string.scrbl"
"lens/private/compound/join-vector.scrbl"
"lens/private/compound/main.scrbl"
"lens/private/compound/thrush.scrbl"
"lens/private/doc-util"
"lens/private/hash/main.scrbl"
"lens/private/hash/nested.scrbl"
"lens/private/hash/pick.scrbl"
"lens/private/hash/ref.scrbl"
"lens/private/list/assoc.scrbl"
"lens/private/list/car-cdr.scrbl"
"lens/private/list/list-ref-take-drop.scrbl"
"lens/private/list/main.scrbl"
"lens/private/list/multi.scrbl"
"lens/private/struct/field.scrbl"
"lens/private/struct/main.scrbl"
"lens/private/struct/struct.scrbl"
"lens/private/test-util"
"lens/private/vector/main.scrbl"
"lens/private/vector/nested.scrbl"
"lens/private/vector/pick.scrbl"
"lens/private/vector/ref.scrbl"
"lens/applicable.scrbl"
"lens/dict.scrbl"
"lens/private/dict.scrbl"
"lens/info.rkt"
"lens/main.scrbl"
"lens/stream.scrbl"
"lens/string.scrbl"
"lens/private/stream.scrbl"
"lens/private/string.scrbl"
"unstable/lens/arrow.scrbl"
"unstable/lens/main.scrbl"
"unstable/lens/sublist.scrbl"

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

@ -11,6 +11,7 @@ require racket/contract
module+ test
require rackunit
racket/set
provide
contract-out
@ -39,7 +40,7 @@ provide
(foldr lens-compose2 identity-lens args)]))
(module+ test
module+ test
(define (set-first l v)
(list* v (rest l)))
(define first-lens (make-lens first set-first))
@ -49,4 +50,7 @@ provide
(define test-alist '((a 1) (b 2) (c 3)))
(define first-of-second-lens (lens-compose first-lens second-lens))
(check-equal? (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-equal? (lens-set first-of-second-lens test-alist 'B) '((a 1) (B 2) (c 3)))
(check-eq? (lens-compose) identity-lens)
(check-pred isomorphism-lens? (lens-compose (make-isomorphism-lens set->list list->set)
(make-isomorphism-lens list->vector vector->list)))

55
lens/private/stream.rkt
View File

@ -1,16 +1,27 @@
#lang racket/base
#lang sweet-exp racket/base
(provide stream-first-lens
stream-rest-lens
stream-ref-lens)
require racket/contract/base
(require racket/stream
fancy-app
"base/main.rkt"
"compound/main.rkt")
provide
contract-out
stream-first-lens (lens/c stream? any/c)
stream-rest-lens (lens/c stream? stream?)
stream-ref-lens (-> exact-nonnegative-integer? (lens/c stream? any/c))
require racket/stream
fancy-app
"base/main.rkt"
"compound/main.rkt"
module+ test
require rackunit
"test-util/test-lens.rkt"
module+ test
(define-check (check-stream-equal? stream1 stream2)
(equal? (stream->list stream1) (stream->list stream2)))
(module+ test
(require rackunit "test-util/test-lens.rkt"))
(define (stream-ref-lens i)
(lens-compose stream-first-lens (stream-tail-lens i)))
@ -43,14 +54,22 @@
(for/fold ([rst rst]) ([v (in-list rev-fst)])
(stream-cons v rst)))
module+ test
(check-equal? (lens-view stream-first-lens (stream 'a 'b 'c)) 'a)
(check-equal? (lens-view (stream-ref-lens 2) (stream 'a 'b 'c)) 'c)
(check-stream-equal? (lens-set stream-first-lens (stream 'a 'b 'c) 1)
(stream 1 'b 'c))
(check-stream-equal? (lens-set (stream-ref-lens 2) (stream 'a 'b 'c) 1)
(stream 'a 'b 1))
(define (stream-ref-nested-lens . is)
(apply lens-thrush (map stream-ref-lens is)))
(module+ test
(check-view stream-first-lens (stream 'a 'b 'c) 'a)
(check-view (stream-ref-lens 2) (stream 'a 'b 'c) 'c)
(check-set-view stream-first-lens (stream 'a 'b 'c) (gensym))
(check-set-view (stream-ref-lens 2) (stream 'a 'b 'c) (gensym))
(check-set-set stream-first-lens (stream 'a 'b 'c) (gensym) (gensym))
(check-set-set (stream-ref-lens 2) (stream 'a 'b 'c) (gensym) (gensym))
)
module+ test
(check-equal? (lens-view (stream-ref-nested-lens 1 2 0)
(stream 'a (stream 1 2 (stream 'foo 'bar 'baz) 3 4) 'b 'c 'd))
'foo)
(check-stream-equal? (lens-set (stream-ref-nested-lens 1 2 0)
(stream 'a (stream 1 2 (stream 'foo 'bar 'baz) 3 4) 'b 'c 'd)
'FOO)
(stream 'a (stream 1 2 (stream 'FOO 'bar 'baz) 3 4) 'b 'c 'd))

68
unstable/lens/set-filterer.rkt
View File

@ -1,26 +1,19 @@
#lang racket/base
#lang sweet-exp racket/base
(require racket/contract/base)
(provide (contract-out
[set-filterer-lens
(-> predicate/c (lens/c functional-set? functional-set?))]
))
require racket/contract/base
(require lens/private/base/main
racket/list
racket/set
fancy-app
)
(module+ test
(require rackunit))
provide
contract-out
set-filterer-lens (-> predicate/c (lens/c functional-set? functional-set?))
require lens/private/base/main
racket/set
racket/function
fancy-app
module+ test
require rackunit
(define (set-filterer-lens pred)
(make-lens
(set-filter pred _)
(λ (tgt nvw)
(unless (andmap pred (set->list nvw))
(error 'set-filterer-lens "expected (set/c ~a), given: ~v" (contract-name pred) nvw))
(set-union (set-filter-not pred tgt) nvw))))
(define (set-filter pred set)
(for/fold ([set set]) ([elem (in-set set)] #:unless (pred elem))
@ -30,11 +23,24 @@
(for/fold ([set set]) ([elem (in-set set)] #:when (pred elem))
(set-remove set elem)))
(define (functional-set? st)
(and (generic-set? st)
(set-implements? st 'set-add 'set-remove)))
(define (andmap-set pred set)
(andmap pred (set->list set)))
(module+ test
(define (check-set-filterer-lens-view pred new-view-to-check)
(unless (andmap-set pred new-view-to-check)
(raise-argument-error 'set-filterer-lens
(format "(set/c ~a)" (contract-name pred))
new-view-to-check)))
(define (set-filterer-lens pred)
(define (insert-filtered-items target new-view)
(check-set-filterer-lens-view pred new-view)
(set-union (set-filter-not pred target) new-view))
(make-lens (set-filter pred _)
insert-filtered-items))
module+ test
(check-equal? (lens-view (set-filterer-lens number?) '(1 a 2 b c 3 d e))
'(1 2 3))
(check-equal? (lens-set (set-filterer-lens number?) '(1 a 2 b c 3 d e) '(4 5 6 7))
@ -43,4 +49,16 @@
(set 1 2 3))
(check-equal? (lens-set (set-filterer-lens number?) (set 1 'a 2 'b 'c 3 'd 'e) (set 4 5 6 7))
(set 4 5 6 7 'a 'b 'c 'd 'e))
)
(check-exn exn:fail:contract?
(thunk (lens-set (set-filterer-lens number?) (set 1) (set 'a))))
(define (functional-set? st)
(and (generic-set? st)
(set-implements? st 'set-add 'set-remove)
(not (set-mutable? st))))
module+ test
(check-true (functional-set? (set 1 2 3)))
(check-true (functional-set? '(1 2 3)))
(check-false (functional-set? (mutable-set 1 2 3)))