Merge pull request #193 from AlexKnauth/set-member

add set-member-lens

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)))

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"

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"

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)))

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))

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)
+]}
+