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

Add tests for functional-set? and cleanup a little

Browse Source
This commit is contained in:
Jack Firth 2015-08-24 13:49:59 -07:00
parent c2c3b85d37
commit b20a6fae6c
1 changed files with 39 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,26 +1,18 @@
#lang racket/base #lang sweet-exp racket/base
(require racket/contract/base) require racket/contract/base
(provide (contract-out
[set-filterer-lens
(-> predicate/c (lens/c functional-set? functional-set?))]
))
(require lens/private/base/main provide
racket/list contract-out
set-filterer-lens (-> predicate/c (lens/c functional-set? functional-set?))
require lens/private/base/main
racket/set racket/set
fancy-app fancy-app
)
(module+ test
(require rackunit))
(define (set-filterer-lens pred) module+ test
(make-lens require rackunit
(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) (define (set-filter pred set)
(for/fold ([set set]) ([elem (in-set set)] #:unless (pred elem)) (for/fold ([set set]) ([elem (in-set set)] #:unless (pred elem))
@ -30,11 +22,24 @@
(for/fold ([set set]) ([elem (in-set set)] #:when (pred elem)) (for/fold ([set set]) ([elem (in-set set)] #:when (pred elem))
(set-remove set elem))) (set-remove set elem)))
(define (functional-set? st) (define (andmap-set pred set)
(and (generic-set? st) (andmap pred (set->list set)))
(set-implements? st 'set-add 'set-remove)))
(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)) (check-equal? (lens-view (set-filterer-lens number?) '(1 a 2 b c 3 d e))
'(1 2 3)) '(1 2 3))
(check-equal? (lens-set (set-filterer-lens number?) '(1 a 2 b c 3 d e) '(4 5 6 7)) (check-equal? (lens-set (set-filterer-lens number?) '(1 a 2 b c 3 d e) '(4 5 6 7))
@ -43,4 +48,13 @@
(set 1 2 3)) (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)) (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)) (set 4 5 6 7 'a 'b 'c 'd 'e))
)
(define (functional-set? st)
(and (generic-set? st)
(set-implements? st 'set-add 'set-remove)))
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)))