move more unstable code to lens/private

lens/private/set/set-filterer.rkt

@@ -0,0 +1,54 @@
+#lang sweet-exp racket/base
+
+require racket/contract/base
+
+provide
+  contract-out
+    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
+
+module+ test
+  require rackunit
+
+
+(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)))
+
+(define (andmap-set pred set)
+  (andmap pred (set->list set)))
+
+
+(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))
+                '(7 6 5 4 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))
+  (check-exn exn:fail:contract?
+             (thunk (lens-set (set-filterer-lens number?) (set 1) (set 'a))))

lens/private/set/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))

lens/private/string/string-split.rkt

@@ -0,0 +1,56 @@
+#lang racket/base
+
+(require racket/contract/base)
+(provide (contract-out
+          [string-split-lens
+           (-> (or/c immutable-string? char? regexp?)
+               (lens/c immutable-string? (listof immutable-string?)))]
+          ))
+
+(require racket/match
+         racket/string
+         lens/private/base/main
+         lens/private/util/immutable
+         )
+(module+ test
+  (require rackunit))
+
+(define (string-split-lens sep)
+  (define sep-rx
+    (cond
+      [(string? sep) (regexp (regexp-quote sep))]
+      [(char? sep) (regexp (regexp-quote (string sep)))]
+      [(regexp? sep) sep]
+      [else (error 'bad)]))
+  (define (get str)
+    (map string->immutable-string (regexp-split sep-rx str)))
+  (define (set str lst)
+    (for ([s (in-list lst)])
+      (when (regexp-match? sep-rx s) ; this would violate the lens laws
+        (error 'string-split-lens "expected a string not matching ~v, given: ~v" sep s)))
+    (define seps (regexp-match* sep-rx str))
+    (match-define (cons fst rst) lst)
+    (string->immutable-string (string-append* fst (map string-append seps rst))))
+  (make-lens get set))
+
+(module+ test
+  (define ws-lens (string-split-lens #px"\\s+"))
+  (check-equal? (lens-view ws-lens "  foo bar  baz \r\n\t")
+                '("" "foo" "bar" "baz" ""))
+  (check-equal? (lens-set ws-lens "  foo bar  baz \r\n\t" '("a" "b" "c" "d" "e"))
+                "a  b c  d \r\n\te")
+  (check-equal? (lens-view ws-lens "a  b c  d \r\n\te")
+                '("a" "b" "c" "d" "e"))
+  (check-equal? (lens-set ws-lens "a  b c  d \r\n\te" '("" "foo" "bar" "baz" ""))
+                "  foo bar  baz \r\n\t")
+  (define newline-lens (string-split-lens "\n"))
+  (check-equal? (lens-view newline-lens "a,b\nc,d\ne,f,g")
+                '("a,b" "c,d" "e,f,g"))
+  (check-equal? (lens-set newline-lens "a,b\nc,d\ne,f,g" '("1" "2" "3"))
+                "1\n2\n3")
+  (define comma-lens (string-split-lens #\,))
+  (check-equal? (lens-view comma-lens "a,b,c")
+                '("a" "b" "c"))
+  (check-equal? (lens-set comma-lens "a,b,c" '("1" "2" "3"))
+                "1,2,3")
+  )

unstable/lens/set-filterer.rkt

@@ -1,54 +1,2 @@
-#lang sweet-exp racket/base
+#lang reprovide
-
+lens/private/set/set-filterer
-require racket/contract/base
-
-provide
-  contract-out
-    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
-
-module+ test
-  require rackunit
-
-
-(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)))
-
-(define (andmap-set pred set)
-  (andmap pred (set->list set)))
-
-
-(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))
-                '(7 6 5 4 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))
-  (check-exn exn:fail:contract?
-             (thunk (lens-set (set-filterer-lens number?) (set 1) (set 'a))))

unstable/lens/set-member.rkt

@@ -1,30 +1,2 @@
-#lang sweet-exp racket/base
+#lang reprovide
-
+lens/private/set/set-member
-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/string-split.rkt

@@ -1,56 +1,2 @@
-#lang racket/base
+#lang reprovide
-
+lens/private/string/string-split
-(require racket/contract/base)
-(provide (contract-out
-          [string-split-lens
-           (-> (or/c immutable-string? char? regexp?)
-               (lens/c immutable-string? (listof immutable-string?)))]
-          ))
-
-(require racket/match
-         racket/string
-         lens/private/base/main
-         lens/private/util/immutable
-         )
-(module+ test
-  (require rackunit))
-
-(define (string-split-lens sep)
-  (define sep-rx
-    (cond
-      [(string? sep) (regexp (regexp-quote sep))]
-      [(char? sep) (regexp (regexp-quote (string sep)))]
-      [(regexp? sep) sep]
-      [else (error 'bad)]))
-  (define (get str)
-    (map string->immutable-string (regexp-split sep-rx str)))
-  (define (set str lst)
-    (for ([s (in-list lst)])
-      (when (regexp-match? sep-rx s) ; this would violate the lens laws
-        (error 'string-split-lens "expected a string not matching ~v, given: ~v" sep s)))
-    (define seps (regexp-match* sep-rx str))
-    (match-define (cons fst rst) lst)
-    (string->immutable-string (string-append* fst (map string-append seps rst))))
-  (make-lens get set))
-
-(module+ test
-  (define ws-lens (string-split-lens #px"\\s+"))
-  (check-equal? (lens-view ws-lens "  foo bar  baz \r\n\t")
-                '("" "foo" "bar" "baz" ""))
-  (check-equal? (lens-set ws-lens "  foo bar  baz \r\n\t" '("a" "b" "c" "d" "e"))
-                "a  b c  d \r\n\te")
-  (check-equal? (lens-view ws-lens "a  b c  d \r\n\te")
-                '("a" "b" "c" "d" "e"))
-  (check-equal? (lens-set ws-lens "a  b c  d \r\n\te" '("" "foo" "bar" "baz" ""))
-                "  foo bar  baz \r\n\t")
-  (define newline-lens (string-split-lens "\n"))
-  (check-equal? (lens-view newline-lens "a,b\nc,d\ne,f,g")
-                '("a,b" "c,d" "e,f,g"))
-  (check-equal? (lens-set newline-lens "a,b\nc,d\ne,f,g" '("1" "2" "3"))
-                "1\n2\n3")
-  (define comma-lens (string-split-lens #\,))
-  (check-equal? (lens-view comma-lens "a,b,c")
-                '("a" "b" "c"))
-  (check-equal? (lens-set comma-lens "a,b,c" '("1" "2" "3"))
-                "1,2,3")
-  )