From 2bbc335ab0c789205211b68e83fcfd93ee338aa8 Mon Sep 17 00:00:00 2001 From: AlexKnauth Date: Mon, 17 Aug 2015 01:58:51 -0400 Subject: [PATCH 1/2] add filterer-lens --- unstable/lens/filterer.rkt | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) create mode 100644 unstable/lens/filterer.rkt diff --git a/unstable/lens/filterer.rkt b/unstable/lens/filterer.rkt new file mode 100644 index 0000000..2dbaf0e --- /dev/null +++ b/unstable/lens/filterer.rkt @@ -0,0 +1,24 @@ +#lang racket/base + +(require lens/base/main + racket/contract/base + racket/list + fancy-app + ) +(module+ test + (require rackunit)) + +(define (filterer-lens pred) + (make-lens + (filter pred _) + (λ (tgt nvw) + (unless (andmap pred nvw) + (error 'filterer-lens "expected (listof ~a), given: ~v" (contract-name pred) nvw)) + (append nvw (filter-not pred tgt))))) + +(module+ test + (check-equal? (lens-view (filterer-lens number?) '(1 a 2 b c 3 d e)) + '(1 2 3)) + (check-equal? (lens-set (filterer-lens number?) '(1 a 2 b c 3 d e) '(4 5 6 7)) + '(4 5 6 7 a b c d e)) + ) From 9afc9a550cf98e249edac3a266dc23978c44baa2 Mon Sep 17 00:00:00 2001 From: AlexKnauth Date: Mon, 17 Aug 2015 02:18:33 -0400 Subject: [PATCH 2/2] add set-filterer-lens --- unstable/lens/filterer.rkt | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/unstable/lens/filterer.rkt b/unstable/lens/filterer.rkt index 2dbaf0e..e43bdd7 100644 --- a/unstable/lens/filterer.rkt +++ b/unstable/lens/filterer.rkt @@ -3,6 +3,7 @@ (require lens/base/main racket/contract/base racket/list + racket/set fancy-app ) (module+ test @@ -16,9 +17,29 @@ (error 'filterer-lens "expected (listof ~a), given: ~v" (contract-name pred) nvw)) (append nvw (filter-not pred tgt))))) +(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)) + (set-remove set elem))) + +(define (set-filter-not pred set) + (for/fold ([set set]) ([elem (in-set set)] #:when (pred elem)) + (set-remove set elem))) + (module+ test (check-equal? (lens-view (filterer-lens number?) '(1 a 2 b c 3 d e)) '(1 2 3)) (check-equal? (lens-set (filterer-lens number?) '(1 a 2 b c 3 d e) '(4 5 6 7)) '(4 5 6 7 a b c d e)) + (check-equal? (lens-view (set-filterer-lens number?) (set 1 'a 2 'b 'c 3 'd 'e)) + (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)) )