diff --git a/lens/private/util/functional-set.rkt b/lens/private/util/functional-set.rkt new file mode 100644 index 0000000..4fe1613 --- /dev/null +++ b/lens/private/util/functional-set.rkt @@ -0,0 +1,17 @@ +#lang sweet-exp racket/base + +provide functional-set? + +require racket/set +module+ test + require rackunit + +(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))) diff --git a/unstable/lens/main.rkt b/unstable/lens/main.rkt index 185a700..a390a8b 100644 --- a/unstable/lens/main.rkt +++ b/unstable/lens/main.rkt @@ -5,6 +5,7 @@ "mapper.rkt" "match.rkt" "set-filterer.rkt" +"set-member.rkt" "string-split.rkt" "struct-join.rkt" "struct-nested.rkt" diff --git a/unstable/lens/main.scrbl b/unstable/lens/main.scrbl index 19d7eaf..32cada2 100644 --- a/unstable/lens/main.scrbl +++ b/unstable/lens/main.scrbl @@ -18,6 +18,7 @@ this library being backwards-compatible. "mapper.scrbl" "match.scrbl" "set-filterer.scrbl" + "set-member.scrbl" "string-split.scrbl" "struct-join.scrbl" "struct-nested.scrbl" diff --git a/unstable/lens/set-filterer.rkt b/unstable/lens/set-filterer.rkt index d941b01..76940ae 100644 --- a/unstable/lens/set-filterer.rkt +++ b/unstable/lens/set-filterer.rkt @@ -7,6 +7,7 @@ provide set-filterer-lens (-> predicate/c (lens/c functional-set? functional-set?)) require lens/private/base/main + lens/private/util/functional-set racket/set racket/function fancy-app @@ -51,14 +52,3 @@ module+ test (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))) diff --git a/unstable/lens/set-member.rkt b/unstable/lens/set-member.rkt new file mode 100644 index 0000000..845c323 --- /dev/null +++ b/unstable/lens/set-member.rkt @@ -0,0 +1,30 @@ +#lang sweet-exp racket/base + +require racket/contract/base +provide + contract-out + set-member-lens (-> any/c (lens/c functional-set? boolean?)) + +require fancy-app + lens/private/base/main + lens/private/util/functional-set + racket/set +module+ test + require rackunit + +(define (set-member-lens v) + (make-lens + (set-member? _ v) + (λ (tgt nvw) + (if nvw + (set-add tgt v) + (set-remove tgt v))))) + +module+ test + (define 2-lens (set-member-lens 2)) + (check-equal? (lens-view 2-lens (set 1 2 3)) #t) + (check-equal? (lens-view 2-lens (set 1 3)) #f) + (check-equal? (lens-set 2-lens (set 1 2 3) #t) (set 1 2 3)) + (check-equal? (lens-set 2-lens (set 1 2 3) #f) (set 1 3)) + (check-equal? (lens-set 2-lens (set 1 3) #t) (set 1 2 3)) + (check-equal? (lens-set 2-lens (set 1 3) #f) (set 1 3)) diff --git a/unstable/lens/set-member.scrbl b/unstable/lens/set-member.scrbl new file mode 100644 index 0000000..cc47b98 --- /dev/null +++ b/unstable/lens/set-member.scrbl @@ -0,0 +1,20 @@ +#lang scribble/manual + +@(require lens/private/doc-util/main) + +@title{Lenses for membership of a set} + +@defmodule[unstable/lens/set-member] + +@defproc[(set-member-lens [v any/c]) (lens/c functional-set? boolean?)]{ +Creates a lens for telling whether @racket[v] is a member of the target set. +@lens-unstable-examples[ + (define 2-lens (set-member-lens 2)) + (lens-view 2-lens (set 1 2 3)) + (lens-view 2-lens (set 1 3)) + (lens-set 2-lens (set 1 2 3) #t) + (lens-set 2-lens (set 1 2 3) #f) + (lens-set 2-lens (set 1 3) #t) + (lens-set 2-lens (set 1 3) #f) +]} +