move more unstable code to lens/private

lens/private/dict/dict-nested.rkt

@@ -0,0 +1,24 @@
+#lang sweet-exp racket/base
+
+require racket/contract/base
+provide
+  contract-out
+    dict-ref-nested-lens (->* [] #:rest (listof any/c) (lens/c functional-dict? any/c))
+
+require lens/private/base/main
+        lens/private/compound/thrush
+        lens/private/dict
+        lens/private/util/functional-dict
+module+ test
+  require rackunit fancy-app
+
+(define (dict-ref-nested-lens . ks)
+  (apply lens-thrush (map dict-ref-lens ks)))
+
+module+ test
+  (define a-x (dict-ref-nested-lens 'a 'x))
+  (let-lens [val ctxt] a-x '([a . ([x . 1] [y . 2])] '[b . ([z . 3])])
+    (check-equal? val 1)
+    (check-equal? (ctxt 100) '([a . ([x . 100] [y . 2])] '[b . ([z . 3])])))
+  (check-equal? (lens-transform/list '([a . ([x . 1] [y . 2])] '[b . ([z . 3])]) a-x (* 10 _))
+                '([a . ([x . 10] [y . 2])] '[b . ([z . 3])]))

lens/private/hash/hash-filterer.rkt

@@ -0,0 +1,60 @@
+#lang sweet-exp racket
+
+;; inspired by https://github.com/jackfirth/racket-auto-fix-deps/blob/master/job/src/filter-hash.rkt
+
+provide
+  contract-out
+    hash-filterer-lens       (-> (-> any/c any/c boolean?) (lens/c immutable-hash? immutable-hash?))
+    hash-filterer-lens/key   (-> predicate/c (lens/c immutable-hash? immutable-hash?))
+    hash-filterer-lens/value (-> predicate/c (lens/c immutable-hash? immutable-hash?))
+
+require fancy-app
+        lens/private/base/main
+        lens/private/util/immutable
+        unstable/hash
+module+ test
+  require lens/private/test-util/test-lens
+          rackunit
+
+(define (hash-filter keep? hsh)
+  (for/hash ([(k v) (in-hash hsh)] #:when (keep? k v))
+    (values k v)))
+
+(define (hash-filter-not drop? hsh)
+  (hash-filter (λ (k v) (not (drop? k v))) hsh))
+
+(define (hash-andmap f hsh)
+  (for/and ([(k v) (in-hash hsh)])
+    (f k v)))
+
+(define (hash-filterer-lens keep?)
+  (make-lens
+   (hash-filter keep? _)
+   (λ (tgt nvw)
+     (unless (hash-andmap keep? nvw)
+       (raise-argument-error 'hash-filterer-lens-setter
+                             (format "a hash where all key-value pairs pass ~v" keep?)
+                             nvw))
+     (hash-union (hash-filter-not keep? tgt) nvw))))
+
+(define (hash-filterer-lens/key keep?)
+  (hash-filterer-lens (λ (k v) (keep? k))))
+
+(define (hash-filterer-lens/value keep?)
+  (hash-filterer-lens (λ (k v) (keep? v))))
+
+module+ test
+  (check-lens-view (hash-filterer-lens/key symbol?) (hash 'a 1 "b" 2 'c 3)
+                   (hash 'a 1 'c 3))
+  (check-lens-set (hash-filterer-lens/key symbol?) (hash 'a 1 "b" 2 'c 3) (hash 'd 4 'e 5)
+                  (hash "b" 2 'd 4 'e 5))
+  (check-lens-view (hash-filterer-lens/value number?) (hash 'a 1 'b "two" 'c 3)
+                   (hash 'a 1 'c 3))
+  (check-lens-set (hash-filterer-lens/value number?) (hash 'a 1 'b "two" 'c 3) (hash 'd 4)
+                  (hash 'b "two" 'd 4))
+  (check-lens-view (hash-filterer-lens =) (hash 1 1.0 2 45 3 3)
+                   (hash 1 1.0 3 3))
+  (check-lens-set (hash-filterer-lens =) (hash 1 1.0 2 45 3 3) (hash 4 4.0 5.0 5)
+                  (hash 2 45 4 4.0 5.0 5))
+  (check-exn exn:fail:contract?
+             (thunk (lens-set (hash-filterer-lens/key symbol?) (hash 'a 1) (hash "d" 4))))

lens/private/if.rkt

@@ -0,0 +1,92 @@
+#lang racket/base
+
+(provide lens-if
+         lens-cond
+         lens-match
+         )
+
+(require lens/private/base/main
+         racket/match
+         (for-syntax racket/base
+                     syntax/parse
+                     ))
+(module+ test
+  (require rackunit lens/private/list/main lens/private/vector/main lens/private/string))
+
+(define (lens-if pred lens1 lens2)
+  (make-lens
+   (λ (tgt)
+     (if (pred tgt)
+         (lens-view lens1 tgt)
+         (lens-view lens2 tgt)))
+   (λ (tgt nvw)
+     (if (pred tgt)
+         (lens-set lens1 tgt nvw)
+         (lens-set lens2 tgt nvw)))))
+
+(define (any? x) #t)
+
+(define-syntax lens-cond
+  (syntax-parser #:literals (else)
+    [(lens-cond [pred-expr:expr lens-expr:expr] ... [else else-lens-expr:expr])
+     #'(lens-cond [pred-expr lens-expr] ... [any? else-lens-expr])]
+    [(lens-cond [pred-expr:expr lens-expr:expr] ...)
+     #:with [pred ...] (generate-temporaries #'[pred-expr ...])
+     #:with [lens ...] (generate-temporaries #'[lens-expr ...])
+     #'(let ([pred pred-expr] ... [lens lens-expr] ...)
+         (make-lens
+          (λ (tgt)
+            (cond [(pred tgt) (lens-view lens tgt)]
+                  ...
+                  [else (raise-lens-cond-error tgt 'pred-expr ...)]))
+          (λ (tgt nvw)
+            (cond [(pred tgt) (lens-set lens tgt nvw)]
+                  ...
+                  [else (raise-lens-cond-error tgt 'pred-expr ...)]))))]))
+
+(define (raise-lens-cond-error tgt . pred-expr-syms)
+  (raise-arguments-error 'lens-cond "no matching clause for target"
+                         "target" tgt
+                         "expected" `(or/c ,@pred-expr-syms)))
+
+(define-syntax lens-match
+  (syntax-parser
+    [(lens-match [pat:expr lens-expr:expr] ...)
+     #'(make-lens
+        (λ (tgt)
+          (match tgt
+            [pat (lens-view lens-expr tgt)]
+            ...))
+        (λ (tgt nvw)
+          (match tgt
+            [pat (lens-set lens-expr tgt nvw)]
+            ...)))]))
+
+(module+ test
+  (define if-lens (lens-if list? first-lens (vector-ref-lens 0)))
+  (check-equal? (lens-view if-lens '(1 2 3)) 1)
+  (check-equal? (lens-view if-lens '#(1 2 3)) 1)
+  (check-equal? (lens-set if-lens '(1 2 3) 'a) '(a 2 3))
+  (check-equal? (lens-set if-lens '#(1 2 3) 'a) '#(a 2 3))
+  (define cond-lens (lens-cond [list? first-lens]
+                               [vector? (vector-ref-lens 0)]
+                               [string? (string-ref-lens 0)]))
+  (check-equal? (lens-view cond-lens '(1 2 3)) 1)
+  (check-equal? (lens-view cond-lens '#(1 2 3)) 1)
+  (check-equal? (lens-view cond-lens "123") #\1)
+  (check-equal? (lens-set cond-lens '(1 2 3) 'a) '(a 2 3))
+  (check-equal? (lens-set cond-lens '#(1 2 3) 'a) '#(a 2 3))
+  (check-equal? (lens-set cond-lens "123" #\a) "a23")
+  (define match-lens (lens-match [(list a) first-lens]
+                                 [(list a b) second-lens]
+                                 [(list a b c) third-lens]
+                                 [(list a ... b) (list-ref-lens (length a))]))
+  (check-equal? (lens-view match-lens '(1)) 1)
+  (check-equal? (lens-view match-lens '(1 2)) 2)
+  (check-equal? (lens-view match-lens '(1 2 3)) 3)
+  (check-equal? (lens-view match-lens '(1 2 3 4 5 6)) 6)
+  (check-equal? (lens-set match-lens '(1) 'a) '(a))
+  (check-equal? (lens-set match-lens '(1 2) 'a) '(1 a))
+  (check-equal? (lens-set match-lens '(1 2 3) 'a) '(1 2 a))
+  (check-equal? (lens-set match-lens '(1 2 3 4 5 6) 'a) '(1 2 3 4 5 a))
+  )

unstable/lens/dict-nested.rkt

@@ -1,24 +1,2 @@
-#lang sweet-exp racket/base
+#lang reprovide
-
+lens/private/dict/dict-nested
-require racket/contract/base
-provide
-  contract-out
-    dict-ref-nested-lens (->* [] #:rest (listof any/c) (lens/c functional-dict? any/c))
-
-require lens/private/base/main
-        lens/private/compound/thrush
-        lens/private/dict
-        lens/private/util/functional-dict
-module+ test
-  require rackunit fancy-app
-
-(define (dict-ref-nested-lens . ks)
-  (apply lens-thrush (map dict-ref-lens ks)))
-
-module+ test
-  (define a-x (dict-ref-nested-lens 'a 'x))
-  (let-lens [val ctxt] a-x '([a . ([x . 1] [y . 2])] '[b . ([z . 3])])
-    (check-equal? val 1)
-    (check-equal? (ctxt 100) '([a . ([x . 100] [y . 2])] '[b . ([z . 3])])))
-  (check-equal? (lens-transform/list '([a . ([x . 1] [y . 2])] '[b . ([z . 3])]) a-x (* 10 _))
-                '([a . ([x . 10] [y . 2])] '[b . ([z . 3])]))

unstable/lens/hash-filterer.rkt

@@ -1,60 +1,2 @@
-#lang sweet-exp racket
+#lang reprovide
-
+lens/private/hash/hash-filterer
-;; inspired by https://github.com/jackfirth/racket-auto-fix-deps/blob/master/job/src/filter-hash.rkt
-
-provide
-  contract-out
-    hash-filterer-lens       (-> (-> any/c any/c boolean?) (lens/c immutable-hash? immutable-hash?))
-    hash-filterer-lens/key   (-> predicate/c (lens/c immutable-hash? immutable-hash?))
-    hash-filterer-lens/value (-> predicate/c (lens/c immutable-hash? immutable-hash?))
-
-require fancy-app
-        lens/private/base/main
-        lens/private/util/immutable
-        unstable/hash
-module+ test
-  require lens/private/test-util/test-lens
-          rackunit
-
-(define (hash-filter keep? hsh)
-  (for/hash ([(k v) (in-hash hsh)] #:when (keep? k v))
-    (values k v)))
-
-(define (hash-filter-not drop? hsh)
-  (hash-filter (λ (k v) (not (drop? k v))) hsh))
-
-(define (hash-andmap f hsh)
-  (for/and ([(k v) (in-hash hsh)])
-    (f k v)))
-
-(define (hash-filterer-lens keep?)
-  (make-lens
-   (hash-filter keep? _)
-   (λ (tgt nvw)
-     (unless (hash-andmap keep? nvw)
-       (raise-argument-error 'hash-filterer-lens-setter
-                             (format "a hash where all key-value pairs pass ~v" keep?)
-                             nvw))
-     (hash-union (hash-filter-not keep? tgt) nvw))))
-
-(define (hash-filterer-lens/key keep?)
-  (hash-filterer-lens (λ (k v) (keep? k))))
-
-(define (hash-filterer-lens/value keep?)
-  (hash-filterer-lens (λ (k v) (keep? v))))
-
-module+ test
-  (check-lens-view (hash-filterer-lens/key symbol?) (hash 'a 1 "b" 2 'c 3)
-                   (hash 'a 1 'c 3))
-  (check-lens-set (hash-filterer-lens/key symbol?) (hash 'a 1 "b" 2 'c 3) (hash 'd 4 'e 5)
-                  (hash "b" 2 'd 4 'e 5))
-  (check-lens-view (hash-filterer-lens/value number?) (hash 'a 1 'b "two" 'c 3)
-                   (hash 'a 1 'c 3))
-  (check-lens-set (hash-filterer-lens/value number?) (hash 'a 1 'b "two" 'c 3) (hash 'd 4)
-                  (hash 'b "two" 'd 4))
-  (check-lens-view (hash-filterer-lens =) (hash 1 1.0 2 45 3 3)
-                   (hash 1 1.0 3 3))
-  (check-lens-set (hash-filterer-lens =) (hash 1 1.0 2 45 3 3) (hash 4 4.0 5.0 5)
-                  (hash 2 45 4 4.0 5.0 5))
-  (check-exn exn:fail:contract?
-             (thunk (lens-set (hash-filterer-lens/key symbol?) (hash 'a 1) (hash "d" 4))))

unstable/lens/if.rkt

@@ -1,92 +1,2 @@
-#lang racket/base
+#lang reprovide
-
+lens/private/if
-(provide lens-if
-         lens-cond
-         lens-match
-         )
-
-(require lens/private/base/main
-         racket/match
-         (for-syntax racket/base
-                     syntax/parse
-                     ))
-(module+ test
-  (require rackunit lens/private/list/main lens/private/vector/main lens/private/string))
-
-(define (lens-if pred lens1 lens2)
-  (make-lens
-   (λ (tgt)
-     (if (pred tgt)
-         (lens-view lens1 tgt)
-         (lens-view lens2 tgt)))
-   (λ (tgt nvw)
-     (if (pred tgt)
-         (lens-set lens1 tgt nvw)
-         (lens-set lens2 tgt nvw)))))
-
-(define (any? x) #t)
-
-(define-syntax lens-cond
-  (syntax-parser #:literals (else)
-    [(lens-cond [pred-expr:expr lens-expr:expr] ... [else else-lens-expr:expr])
-     #'(lens-cond [pred-expr lens-expr] ... [any? else-lens-expr])]
-    [(lens-cond [pred-expr:expr lens-expr:expr] ...)
-     #:with [pred ...] (generate-temporaries #'[pred-expr ...])
-     #:with [lens ...] (generate-temporaries #'[lens-expr ...])
-     #'(let ([pred pred-expr] ... [lens lens-expr] ...)
-         (make-lens
-          (λ (tgt)
-            (cond [(pred tgt) (lens-view lens tgt)]
-                  ...
-                  [else (raise-lens-cond-error tgt 'pred-expr ...)]))
-          (λ (tgt nvw)
-            (cond [(pred tgt) (lens-set lens tgt nvw)]
-                  ...
-                  [else (raise-lens-cond-error tgt 'pred-expr ...)]))))]))
-
-(define (raise-lens-cond-error tgt . pred-expr-syms)
-  (raise-arguments-error 'lens-cond "no matching clause for target"
-                         "target" tgt
-                         "expected" `(or/c ,@pred-expr-syms)))
-
-(define-syntax lens-match
-  (syntax-parser
-    [(lens-match [pat:expr lens-expr:expr] ...)
-     #'(make-lens
-        (λ (tgt)
-          (match tgt
-            [pat (lens-view lens-expr tgt)]
-            ...))
-        (λ (tgt nvw)
-          (match tgt
-            [pat (lens-set lens-expr tgt nvw)]
-            ...)))]))
-
-(module+ test
-  (define if-lens (lens-if list? first-lens (vector-ref-lens 0)))
-  (check-equal? (lens-view if-lens '(1 2 3)) 1)
-  (check-equal? (lens-view if-lens '#(1 2 3)) 1)
-  (check-equal? (lens-set if-lens '(1 2 3) 'a) '(a 2 3))
-  (check-equal? (lens-set if-lens '#(1 2 3) 'a) '#(a 2 3))
-  (define cond-lens (lens-cond [list? first-lens]
-                               [vector? (vector-ref-lens 0)]
-                               [string? (string-ref-lens 0)]))
-  (check-equal? (lens-view cond-lens '(1 2 3)) 1)
-  (check-equal? (lens-view cond-lens '#(1 2 3)) 1)
-  (check-equal? (lens-view cond-lens "123") #\1)
-  (check-equal? (lens-set cond-lens '(1 2 3) 'a) '(a 2 3))
-  (check-equal? (lens-set cond-lens '#(1 2 3) 'a) '#(a 2 3))
-  (check-equal? (lens-set cond-lens "123" #\a) "a23")
-  (define match-lens (lens-match [(list a) first-lens]
-                                 [(list a b) second-lens]
-                                 [(list a b c) third-lens]
-                                 [(list a ... b) (list-ref-lens (length a))]))
-  (check-equal? (lens-view match-lens '(1)) 1)
-  (check-equal? (lens-view match-lens '(1 2)) 2)
-  (check-equal? (lens-view match-lens '(1 2 3)) 3)
-  (check-equal? (lens-view match-lens '(1 2 3 4 5 6)) 6)
-  (check-equal? (lens-set match-lens '(1) 'a) '(a))
-  (check-equal? (lens-set match-lens '(1 2) 'a) '(1 a))
-  (check-equal? (lens-set match-lens '(1 2 3) 'a) '(1 2 a))
-  (check-equal? (lens-set match-lens '(1 2 3 4 5 6) 'a) '(1 2 3 4 5 a))
-  )