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

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

@ -1,26 +1,18 @@
#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
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 +22,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 +48,13 @@
(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))
)
(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)))