move more unstable code to lens/private

lens/private/compound/join-assoc.rkt

@@ -0,0 +1,35 @@
+#lang sweet-exp racket/base
+
+require racket/contract/base
+provide
+  contract-out
+    lens-join/assoc (->* [] #:rest (listof2 any/c lens?) (lens/c any/c (listof pair?)))
+
+require lens/private/base/main
+        lens/private/compound/join-list
+        lens/private/list/assoc
+        lens/private/util/alternating-list
+        lens/private/util/list-pair-contract
+        racket/match
+        unstable/sequence
+module+ test
+  require rackunit lens/private/list/main
+
+(define (lens-join/assoc . ks/lenses)
+  (define-values [keys lenses]
+    (alternating-list->keys+values ks/lenses))
+  (define key-lenses (map assoc-lens keys))
+  (define list-lens (apply lens-join/list lenses))
+  (make-lens
+   (λ (tgt)
+     (keys+values->assoc-list keys (lens-view list-lens tgt)))
+   (λ (tgt nvw)
+     (lens-set list-lens tgt (apply lens-view/list nvw key-lenses)))))
+
+module+ test
+  (define a-b-lens (lens-join/assoc 'a first-lens
+                                    'b third-lens))
+  (check-equal? (lens-view a-b-lens '(1 2 3))
+                '((a . 1) (b . 3)))
+  (check-equal? (lens-set a-b-lens '(1 2 3) '((a . 100) (b . 200)))
+                '(100 2 200))

lens/private/list/map.rkt

@@ -0,0 +1,55 @@
+#lang racket/base
+
+(require racket/contract/base)
+(provide (contract-out
+          [map-lens
+           (-> lens? (lens/c list? list?))]
+          [vector-map-lens
+           (-> lens? (lens/c immutable-vector? immutable-vector?))]
+          ))
+
+(require lens/private/base/main
+         lens/private/util/immutable
+         racket/vector
+         fancy-app
+         )
+(module+ test
+  (require rackunit lens/private/list/main))
+
+(define (map-lens lens)
+  (make-lens
+   (lens-view/map lens _)
+   (lens-set/map lens _ _)))
+
+(define (lens-view/map lens tgts)
+  (map (lens-view lens _) tgts))
+
+(define (lens-set/map lens tgts new-views)
+  (map (lens-set lens _ _) tgts new-views))
+
+(define (vector-map-lens lens)
+  (make-lens
+   (lens-view/vector-map lens _)
+   (lens-set/vector-map lens _ _)))
+
+(define (lens-view/vector-map lens tgt)
+  (vector->immutable-vector (vector-map (lens-view lens _) tgt)))
+
+(define (lens-set/vector-map lens tgt new-view)
+  (vector->immutable-vector (vector-map (lens-set lens _ _) tgt new-view)))
+
+(module+ test
+  (check-equal? (lens-view (map-lens first-lens) '((a b) (c d) (e f)))
+                '(a c e))
+  (check-equal? (lens-set (map-lens first-lens) '((a b) (c d) (e f)) '(1 2 3))
+                '((1 b) (2 d) (3 f)))
+  (check-equal? (lens-transform (map-lens first-lens) '((a b) (c d) (e f)) (map symbol->string _))
+                '(("a" b) ("c" d) ("e" f)))
+  (check-equal? (lens-view (vector-map-lens first-lens) '#((a b) (c d) (e f)))
+                '#(a c e))
+  (check-equal? (lens-set (vector-map-lens first-lens) '#((a b) (c d) (e f)) '#(1 2 3))
+                '#((1 b) (2 d) (3 f)))
+  (check-equal? (lens-transform (vector-map-lens first-lens) '#((a b) (c d) (e f))
+                                (immutable-vector-map symbol->string _))
+                '#(("a" b) ("c" d) ("e" f)))
+  )

lens/private/match.rkt

@@ -0,0 +1,34 @@
+#lang racket/base
+
+(provide match-lens)
+
+(require racket/match
+         racket/local
+         syntax/parse/define
+         lens/private/base/main
+         )
+(module+ test
+  (require rackunit lens/private/test-util/test-lens))
+
+(define-simple-macro (match-lens a:id pat:expr replacement:expr)
+  (local [(define (get target)
+            (match target
+              [pat
+               a]))
+          (define (set target new-view)
+            (match target
+              [pat
+               (let ([a new-view])
+                 replacement)]))]
+    (make-lens get set)))
+
+(module+ test
+  (define car-lens (match-lens a (cons a b) (cons a b)))
+  (define cdr-lens (match-lens b (cons a b) (cons a b)))
+  (check-lens-view car-lens (cons 1 2) 1)
+  (check-lens-view cdr-lens (cons 1 2) 2)
+  (check-lens-set car-lens (cons 1 2) 'a (cons 'a 2))
+  (check-lens-set cdr-lens (cons 1 2) 'a (cons 1 'a))
+  (test-lens-laws car-lens (cons 1 2) 'a 'b)
+  (test-lens-laws cdr-lens (cons 1 2) 'a 'b)
+  )

unstable/lens/join-assoc.rkt

@@ -1,35 +1,2 @@
-#lang sweet-exp racket/base
-
-require racket/contract/base
-provide
-  contract-out
-    lens-join/assoc (->* [] #:rest (listof2 any/c lens?) (lens/c any/c (listof pair?)))
-
-require lens/private/base/main
-        lens/private/compound/join-list
-        lens/private/list/assoc
-        lens/private/util/alternating-list
-        lens/private/util/list-pair-contract
-        racket/match
-        unstable/sequence
-module+ test
-  require rackunit lens/private/list/main
-
-(define (lens-join/assoc . ks/lenses)
-  (define-values [keys lenses]
-    (alternating-list->keys+values ks/lenses))
-  (define key-lenses (map assoc-lens keys))
-  (define list-lens (apply lens-join/list lenses))
-  (make-lens
-   (λ (tgt)
-     (keys+values->assoc-list keys (lens-view list-lens tgt)))
-   (λ (tgt nvw)
-     (lens-set list-lens tgt (apply lens-view/list nvw key-lenses)))))
-
-module+ test
-  (define a-b-lens (lens-join/assoc 'a first-lens
-                                    'b third-lens))
-  (check-equal? (lens-view a-b-lens '(1 2 3))
-                '((a . 1) (b . 3)))
-  (check-equal? (lens-set a-b-lens '(1 2 3) '((a . 100) (b . 200)))
-                '(100 2 200))
+#lang reprovide
+lens/private/compound/join-assoc

unstable/lens/map.rkt

@@ -1,55 +1,2 @@
-#lang racket/base
-
-(require racket/contract/base)
-(provide (contract-out
-          [map-lens
-           (-> lens? (lens/c list? list?))]
-          [vector-map-lens
-           (-> lens? (lens/c immutable-vector? immutable-vector?))]
-          ))
-
-(require lens/private/base/main
-         lens/private/util/immutable
-         racket/vector
-         fancy-app
-         )
-(module+ test
-  (require rackunit lens/private/list/main))
-
-(define (map-lens lens)
-  (make-lens
-   (lens-view/map lens _)
-   (lens-set/map lens _ _)))
-
-(define (lens-view/map lens tgts)
-  (map (lens-view lens _) tgts))
-
-(define (lens-set/map lens tgts new-views)
-  (map (lens-set lens _ _) tgts new-views))
-
-(define (vector-map-lens lens)
-  (make-lens
-   (lens-view/vector-map lens _)
-   (lens-set/vector-map lens _ _)))
-
-(define (lens-view/vector-map lens tgt)
-  (vector->immutable-vector (vector-map (lens-view lens _) tgt)))
-
-(define (lens-set/vector-map lens tgt new-view)
-  (vector->immutable-vector (vector-map (lens-set lens _ _) tgt new-view)))
-
-(module+ test
-  (check-equal? (lens-view (map-lens first-lens) '((a b) (c d) (e f)))
-                '(a c e))
-  (check-equal? (lens-set (map-lens first-lens) '((a b) (c d) (e f)) '(1 2 3))
-                '((1 b) (2 d) (3 f)))
-  (check-equal? (lens-transform (map-lens first-lens) '((a b) (c d) (e f)) (map symbol->string _))
-                '(("a" b) ("c" d) ("e" f)))
-  (check-equal? (lens-view (vector-map-lens first-lens) '#((a b) (c d) (e f)))
-                '#(a c e))
-  (check-equal? (lens-set (vector-map-lens first-lens) '#((a b) (c d) (e f)) '#(1 2 3))
-                '#((1 b) (2 d) (3 f)))
-  (check-equal? (lens-transform (vector-map-lens first-lens) '#((a b) (c d) (e f))
-                                (immutable-vector-map symbol->string _))
-                '#(("a" b) ("c" d) ("e" f)))
-  )
+#lang reprovide
+lens/private/list/map

unstable/lens/match.rkt

@@ -1,34 +1,2 @@
-#lang racket/base
-
-(provide match-lens)
-
-(require racket/match
-         racket/local
-         syntax/parse/define
-         lens/private/base/main
-         )
-(module+ test
-  (require rackunit lens/private/test-util/test-lens))
-
-(define-simple-macro (match-lens a:id pat:expr replacement:expr)
-  (local [(define (get target)
-            (match target
-              [pat
-               a]))
-          (define (set target new-view)
-            (match target
-              [pat
-               (let ([a new-view])
-                 replacement)]))]
-    (make-lens get set)))
-
-(module+ test
-  (define car-lens (match-lens a (cons a b) (cons a b)))
-  (define cdr-lens (match-lens b (cons a b) (cons a b)))
-  (check-lens-view car-lens (cons 1 2) 1)
-  (check-lens-view cdr-lens (cons 1 2) 2)
-  (check-lens-set car-lens (cons 1 2) 'a (cons 'a 2))
-  (check-lens-set cdr-lens (cons 1 2) 'a (cons 1 'a))
-  (test-lens-laws car-lens (cons 1 2) 'a 'b)
-  (test-lens-laws cdr-lens (cons 1 2) 'a 'b)
-  )
+#lang reprovide
+lens/private/match