start moving unstable code to lens/private

lens/private/compound/arrow.rkt

@@ -0,0 +1,41 @@
+#lang racket/base
+
+(provide lens-view~>
+         lens-set~>
+         lens-transform~>
+         lens-view/thrush
+         lens-set/thrush
+         lens-transform/thrush)
+
+(require lens)
+
+(module+ test
+  (require rackunit racket/list fancy-app))
+
+(define (lens-view~> target . lenses)
+  (for/fold ([target target]) ([lens (in-list lenses)])
+    (lens-view lens target)))
+
+(define (lens-set~> target #:-> new-val . lenses)
+  (lens-set (apply lens-thrush lenses) target new-val))
+
+(define (lens-transform~> target #:-> transformer . lenses)
+  (lens-transform (apply lens-thrush lenses) target transformer))
+
+(define lens-view/thrush lens-view~>)
+(define lens-set/thrush lens-set~>)
+(define lens-transform/thrush lens-transform~>)
+
+(module+ test
+  (define (set-first l v)
+    (list* v (rest l)))
+  (define (set-second l v)
+    (list* (first l) v (rest (rest l))))
+  (define first-lens (make-lens first set-first))
+  (define second-lens (make-lens second set-second))
+  (check-equal? (lens-view~> '((1 2) 3) first-lens second-lens)
+                2)
+  (check-equal? (lens-set~> '((1 2) 3) first-lens second-lens #:-> 'two)
+                '((1 two) 3))
+  (check-equal? (lens-transform~> '((1 2) 3) first-lens second-lens #:-> (* 100 _))
+                '((1 200) 3)))

lens/private/define-nested.rkt

@@ -0,0 +1,74 @@
+#lang sweet-exp racket/base
+
+provide define-nested-lenses
+
+require lens/private/compound/thrush
+        for-syntax racket/base
+                   racket/syntax
+                   syntax/parse
+                   syntax/srcloc
+                   "util/id-append.rkt"
+module+ test
+  require lens/private/base/base
+          lens/private/list/main
+          rackunit
+
+begin-for-syntax
+  (define (with-sub-range-binders stx prop)
+    (syntax-property stx 'sub-range-binders prop))
+  (define -- (update-source-location (datum->syntax #f '-)
+                                    #:span 1))
+  (define -lens (update-source-location (datum->syntax #f '-lens)
+                                        #:span 5))
+  ;; helper syntax-class for define-nested-lenses
+  (define-syntax-class (clause base-id base-lens-tmp)
+    #:attributes (def)
+    [pattern [suffix-id:id suffix-lens-expr:expr
+               unchecked-clause ...]
+             #:with base-lens:id base-lens-tmp
+             #:do [(define-values [base-suffix-id base-suffix-sub-range]
+                     (id-append #:context base-id
+                                base-id -- #'suffix-id))
+                   (define-values [base-suffix-lens-id base-suffix-lens-sub-range]
+                     (id-append #:context base-id
+                                base-suffix-id -lens))]
+             #:with base-suffix
+             base-suffix-id
+             #:with base-suffix-lens
+             base-suffix-lens-id
+             #:with [(~var clause (clause #'base-suffix #'base-suffix-lens)) ...]
+             #'[unchecked-clause ...]
+             #:with def
+             (with-sub-range-binders
+              #'(begin
+                  (define base-suffix-lens
+                    (lens-thrush base-lens suffix-lens-expr))
+                  clause.def
+                  ...)
+              base-suffix-lens-sub-range)])
+
+
+(define-syntax define-nested-lenses
+  (syntax-parser
+    [(define-nested-lenses [base:id base-lens-expr:expr]
+       (~parse base-lens:id (generate-temporary #'base))
+       (~var clause (clause #'base #'base-lens))
+       ...)
+     #'(begin
+         (define base-lens base-lens-expr)
+         clause.def
+         ...)]))
+
+module+ test
+  (define-nested-lenses [first first-lens]
+    [first first-lens]
+    [second second-lens]
+    [third third-lens
+      [first first-lens]
+      [second second-lens]])
+  (check-equal? (lens-view first-first-lens '((a b c d) e)) 'a)
+  (check-equal? (lens-view first-second-lens '((a b c d) e)) 'b)
+  (check-equal? (lens-view first-third-lens '((a b c d) e)) 'c)
+  (check-equal? (lens-view first-third-first-lens '((a b (c d) e) f)) 'c)
+  (check-equal? (lens-view first-third-second-lens '((a b (c d) e) f)) 'd)
+

unstable/lens/arrow.rkt

@@ -1,41 +1,2 @@
-#lang racket/base
-
-(provide lens-view~>
-         lens-set~>
-         lens-transform~>
-         lens-view/thrush
-         lens-set/thrush
-         lens-transform/thrush)
-
-(require lens)
-
-(module+ test
-  (require rackunit racket/list fancy-app))
-
-(define (lens-view~> target . lenses)
-  (for/fold ([target target]) ([lens (in-list lenses)])
-    (lens-view lens target)))
-
-(define (lens-set~> target #:-> new-val . lenses)
-  (lens-set (apply lens-thrush lenses) target new-val))
-
-(define (lens-transform~> target #:-> transformer . lenses)
-  (lens-transform (apply lens-thrush lenses) target transformer))
-
-(define lens-view/thrush lens-view~>)
-(define lens-set/thrush lens-set~>)
-(define lens-transform/thrush lens-transform~>)
-
-(module+ test
-  (define (set-first l v)
-    (list* v (rest l)))
-  (define (set-second l v)
-    (list* (first l) v (rest (rest l))))
-  (define first-lens (make-lens first set-first))
-  (define second-lens (make-lens second set-second))
-  (check-equal? (lens-view~> '((1 2) 3) first-lens second-lens)
-                2)
-  (check-equal? (lens-set~> '((1 2) 3) first-lens second-lens #:-> 'two)
-                '((1 two) 3))
-  (check-equal? (lens-transform~> '((1 2) 3) first-lens second-lens #:-> (* 100 _))
-                '((1 200) 3)))
+#lang reprovide
+lens/private/compound/arrow

unstable/lens/define-nested.rkt

@@ -1,74 +1,2 @@
-#lang sweet-exp racket/base
-
-provide define-nested-lenses
-
-require lens/private/compound/thrush
-        for-syntax racket/base
-                   racket/syntax
-                   syntax/parse
-                   syntax/srcloc
-                   "private/id-append.rkt"
-module+ test
-  require lens/private/base/base
-          lens/private/list/main
-          rackunit
-
-begin-for-syntax
-  (define (with-sub-range-binders stx prop)
-    (syntax-property stx 'sub-range-binders prop))
-  (define -- (update-source-location (datum->syntax #f '-)
-                                    #:span 1))
-  (define -lens (update-source-location (datum->syntax #f '-lens)
-                                        #:span 5))
-  ;; helper syntax-class for define-nested-lenses
-  (define-syntax-class (clause base-id base-lens-tmp)
-    #:attributes (def)
-    [pattern [suffix-id:id suffix-lens-expr:expr
-               unchecked-clause ...]
-             #:with base-lens:id base-lens-tmp
-             #:do [(define-values [base-suffix-id base-suffix-sub-range]
-                     (id-append #:context base-id
-                                base-id -- #'suffix-id))
-                   (define-values [base-suffix-lens-id base-suffix-lens-sub-range]
-                     (id-append #:context base-id
-                                base-suffix-id -lens))]
-             #:with base-suffix
-             base-suffix-id
-             #:with base-suffix-lens
-             base-suffix-lens-id
-             #:with [(~var clause (clause #'base-suffix #'base-suffix-lens)) ...]
-             #'[unchecked-clause ...]
-             #:with def
-             (with-sub-range-binders
-              #'(begin
-                  (define base-suffix-lens
-                    (lens-thrush base-lens suffix-lens-expr))
-                  clause.def
-                  ...)
-              base-suffix-lens-sub-range)])
-
-
-(define-syntax define-nested-lenses
-  (syntax-parser
-    [(define-nested-lenses [base:id base-lens-expr:expr]
-       (~parse base-lens:id (generate-temporary #'base))
-       (~var clause (clause #'base #'base-lens))
-       ...)
-     #'(begin
-         (define base-lens base-lens-expr)
-         clause.def
-         ...)]))
-
-module+ test
-  (define-nested-lenses [first first-lens]
-    [first first-lens]
-    [second second-lens]
-    [third third-lens
-      [first first-lens]
-      [second second-lens]])
-  (check-equal? (lens-view first-first-lens '((a b c d) e)) 'a)
-  (check-equal? (lens-view first-second-lens '((a b c d) e)) 'b)
-  (check-equal? (lens-view first-third-lens '((a b c d) e)) 'c)
-  (check-equal? (lens-view first-third-first-lens '((a b (c d) e) f)) 'c)
-  (check-equal? (lens-view first-third-second-lens '((a b (c d) e) f)) 'd)
-
+#lang reprovide
+lens/private/define-nested