string-split-lens: add tests where inputs would violate the lens laws

fixes https://github.com/jackfirth/lens/issues/261

.gitignore

@@ -1,7 +1,7 @@
 **/compiled/*
+doc/
 **/*.bak
 **/*.html
-**/*.css
 **/*.js
 *~
 **.rktd

.travis.yml

@@ -1,22 +1,36 @@
-langauge: c
+language: c
 sudo: false
 env:
   global:
     - RACKET_DIR=~/racket
+    - VERSION_TO_COVER="6.5"
   matrix:
-    - RACKET_VERSION=6.1.1
-    - RACKET_VERSION=6.2
-    - RACKET_VERSION=HEAD
+    - RACKET_VERSION="6.0.1" CATALOG_VERSION="6.0.1"
+    - RACKET_VERSION="6.1" CATALOG_VERSION="6.1"
+    - RACKET_VERSION="6.1.1" CATALOG_VERSION="6.1.1"
+    - RACKET_VERSION="6.2" CATALOG_VERSION="6.2"
+    - RACKET_VERSION="6.2.1" CATALOG_VERSION="6.2.1"
+    - RACKET_VERSION="6.3" CATALOG_VERSION="6.3"
+    - RACKET_VERSION="6.4" CATALOG_VERSION="6.4"
+    - RACKET_VERSION="6.5" CATALOG_VERSION="6.5"
+    - RACKET_VERSION="6.6" CATALOG_VERSION="6.6"
+    - RACKET_VERSION="HEAD" CATALOG_VERSION="6.6"
+matrix:
+  allow_failures:
+    - env: RACKET_VERSION="HEAD" CATALOG_VERSION="6.6"
 
 before_install:
   - git clone https://github.com/greghendershott/travis-racket.git ../travis-racket
   - cat ../travis-racket/install-racket.sh | bash
   - export PATH="${RACKET_DIR}/bin:${PATH}"
+  - export VERSION_SPECIFIC_CATALOG="http://download.racket-lang.org/releases/${CATALOG_VERSION}/catalog/"
+  - raco pkg config --set catalogs $VERSION_SPECIFIC_CATALOG http://pkgs.racket-lang.org http://planet-compats.racket-lang.org
+  - if [ "${VERSION_TO_COVER}" == "${RACKET_VERSION}" ]; then raco pkg install --auto cover cover-coveralls; fi
 
-install: raco pkg install --deps search-auto $TRAVIS_BUILD_DIR # install dependencies
+install:
+ - raco pkg install --auto lens-common/ lens-data/ lens-lib/ lens-unstable/ lens-doc/ lens/
 
 script:
- - raco test $TRAVIS_BUILD_DIR # run tests. you wrote tests, right?
-
-after_success:
- - raco cover -f coveralls -d $TRAVIS_BUILD_DIR/coverage . # generate coverage information for coveralls
+ - raco test -p lens-common lens-data lens-lib lens-unstable lens-doc lens
+ - if [ "${VERSION_TO_COVER}" == "${RACKET_VERSION}" ]; then raco cover -f coveralls -d $TRAVIS_BUILD_DIR/coverage -p lens-common lens-data lens-lib lens-unstable lens-doc lens; fi
+ - raco setup

LICENSE

@@ -0,0 +1,23 @@
+The MIT License (MIT)
+
+Copyright (c) 2015 Jack Firth
+Modified work Copyright 2015 Alex Knauth
+Modified work Copyright 2015 Google Inc.
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

README.md

@@ -1,15 +1,78 @@
-lens [![Build Status](https://travis-ci.org/jackfirth/lens.svg?branch=master)](https://travis-ci.org/jackfirth/lens) [![Coverage Status](https://coveralls.io/repos/jackfirth/lens/badge.svg)](https://coveralls.io/r/jackfirth/lens) [![Stories in Ready](https://badge.waffle.io/jackfirth/lens.png?label=ready&title=Ready)](https://waffle.io/jackfirth/lens) 
-===================================
-Documentation: [`lens`](http://pkg-build.racket-lang.org/doc/lens/index.html) [`unstable/lens`](http://pkg-build.racket-lang.org/doc/unstable-lens/index.html)
-
-Latest Version: `1.2`
+# lens ![Version](https://img.shields.io/badge/Version-2.0-green.svg) [![Build Status](https://travis-ci.org/jackfirth/lens.svg?branch=master)](https://travis-ci.org/jackfirth/lens) [![Coverage Status](https://coveralls.io/repos/jackfirth/lens/badge.svg)](https://coveralls.io/r/jackfirth/lens) [![Stories in Ready](https://badge.waffle.io/jackfirth/lens.png?label=ready&title=Ready)](https://waffle.io/jackfirth/lens) [![Scribble Docs](https://img.shields.io/badge/Docs-Scribble%20-blue.svg)](http://pkg-build.racket-lang.org/doc/lens/index.html) [![Join the chat at https://gitter.im/jackfirth/lens](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/jackfirth/lens?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge)
 
 A Racket package for creating and composing pure functional lenses.
 
 `raco pkg install lens`
 `(require lens)`
 
-A lens is a value that can be used to focus on a small subpiece of some larger structure. Given a lens and a value of that larger structure, two values can be dervied: a *view* value, which is the subpiece, and a *context* function, which accepts a new view value and returns a new structure with the old view replaced by the new view. Think of them as composable, pure functional getters and setters. Examples can be found in the documentation.
+### What on earth are lenses?
+
+A lens is a value that can be used to focus on a small subpiece of some larger structure. A lens splits some data structure into two pieces - a *view*, which is some small isolated component of the data structure, and a *context*, which is everything else. The context can have a new view placed into it. This makes a lens act like a pure functional getter and setter:
+
+```racket
+> (lens-view first-lens '(1 2 3))
+1
+> (lens-set first-lens '(1 2 3) 'a)
+'(a 2 3)
+```
+
+Lenses are first class values and pure functional, so they can be abstracted over and functions that operate on lenses can be created. For instance, given a lens its view can be "updated":
+
+```racket
+> (lens-transform first-lens '(1 2 3) number->string)
+'("1" 2 3)
+```
+
+Additionaly, lenses are separate values from the objects they operate on, so they can be manipulated independently of any specific data. Functions can construct lenses, and operations can combine lenses. This allows for *lens composition*:
+
+```racket
+> (define first-of-b-key-lens (lens-compose first-lens (hash-ref-lens 'b)))
+> (define a-hash (hash 'a '(1 2 3) 'b '(10 20 30) 'c '(100 200 300)))
+> (lens-view first-of-b-key-lens a-hash)
+10
+> (lens-set first-of-b-key-lens a-hash 'foo)
+#hash((a . (1 2 3)) (b . (foo 20 30)) (c . (100 200 300)))
+```
+
+Lenses can also be joined together to form compound lenses that view many things:
+
+```racket
+> (define first-third-fifth-lens (lens-join/list first-lens third-lens fifth-lens))
+> (lens-view first-third-fifth-lens '(1 2 3 4 5 6))
+'(1 3 5)
+> (lens-set first-third-fifth-lens '(1 2 3 4 5 6) '(a b c))
+'(a 2 b 4 c 6)
+```
+
+Lenses can also be extended to operate on some new data structure:
+
+```racket
+> (define first-of-each-lens (map-lens first-lens))
+> (lens-view first-of-each-lens '((1 2) (3 4) (5 6)))
+'(1 3 5)
+> (lens-set first-of-each-lens '((1 2) (3 4) (5 6)) '(a b c))
+'((a 2) (b 4) (c 6))
+```
+
+See [the documentation](http://pkg-build.racket-lang.org/doc/lens/index.html) for a full API reference
+
+#### So when would I want to use lenses?
+
+Lenses are most effective when you're dealing with the "giant ball of state" problem. When you
+have a large amount of state you need to pass around between code written in a functional
+style, it's difficult to update and manage it due to the lack of mutation "magically" updating
+your entire object graph when a function changes a small part of it. Lenses allow code to
+break down and manipulate portions of this state, simplifying interactions and updates.
+
+In particular, consider using lenses if you find yourself doing any of the following:
+
+- Using a giant complex piece of state that most pieces of code only care about a small part of
+- Writing `struct-copy` a lot
+- Converting some hairy data structure into another one, manipulating it, then turning it back
+- Wishing you could treat data X as if it were a Y, i.e. "I wish this struct was a list so I could `map` over it easily"
+- Creating structs that have nested struct instances inside them.
+
+For a more in depth introduction, see [The Lens Guide](http://pkg-build.racket-lang.org/doc/lens/lens-guide.html). For detailed API documentation, see [The Lens Reference](http://pkg-build.racket-lang.org/doc/lens/lens-reference.html).
 
 #### Contributions
 

info.rkt

@@ -1,68 +0,0 @@
-#lang info
-
-(define collection 'multi)
-
-
-(define version "2.0")
-
-
-(define deps
-  '("base"
-    "rackunit-lib"
-    "unstable-lib"
-    "fancy-app"
-    "alexis-util"
-    "scribble-lib"))
-
-
-(define build-deps
-  '("cover"
-    "rackunit-lib"
-    "racket-doc"
-    "doc-coverage"))
-
-
-(define test-omit-paths
-  '("info.rkt"
-    "lens/base/base.scrbl"
-    "lens/base/contract.scrbl"
-    "lens/base/laws.scrbl"
-    "lens/base/main.scrbl"
-    "lens/base/transform.scrbl"
-    "lens/base/view-set.scrbl"
-    "lens/compound/compose.scrbl"
-    "lens/compound/join-hash.scrbl"
-    "lens/compound/join-list.scrbl"
-    "lens/compound/join-string.scrbl"
-    "lens/compound/join-vector.scrbl"
-    "lens/compound/main.scrbl"
-    "lens/compound/thrush.scrbl"
-    "lens/doc-util"
-    "lens/hash/main.scrbl"
-    "lens/hash/nested.scrbl"
-    "lens/hash/pick.scrbl"
-    "lens/hash/ref.scrbl"
-    "lens/list/assoc.scrbl"
-    "lens/list/car-cdr.scrbl"
-    "lens/list/list-ref-take-drop.scrbl"
-    "lens/list/main.scrbl"
-    "lens/list/multi.scrbl"
-    "lens/struct/field.scrbl"
-    "lens/struct/main.scrbl"
-    "lens/struct/struct.scrbl"
-    "lens/test-util"
-    "lens/vector/main.scrbl"
-    "lens/vector/nested.scrbl"
-    "lens/vector/pick.scrbl"
-    "lens/vector/ref.scrbl"
-    "lens/applicable.scrbl"
-    "lens/dict.scrbl"
-    "lens/info.rkt"
-    "lens/main.scrbl"
-    "lens/stream.scrbl"
-    "lens/string.scrbl"
-    "unstable/lens/arrow.scrbl"
-    "unstable/lens/main.scrbl"
-    "unstable/lens/sublist.scrbl"
-    "unstable/lens/syntax.scrbl"
-    "unstable/lens/view-set.scrbl"))

lens-common/info.rkt

@@ -0,0 +1,26 @@
+#lang info
+
+(define collection 'multi)
+
+(define deps
+  '("base"
+    "fancy-app"
+    "rackunit-lib"
+    "reprovide-lang"
+    "unstable-contract-lib"
+    "unstable-lib"
+    ))
+
+(define build-deps
+  '("lens-data"
+    "sweet-exp-lib"
+    ))
+
+(define cover-omit-paths
+  '(#rx"info\\.rkt"
+    #rx"main\\.rkt"
+    "lens/common.rkt"
+    "lens/private/test-util"
+    "lens/private/util"
+    ))
+

lens-common/lens/common.rkt

@@ -0,0 +1,8 @@
+#lang sweet-exp reprovide
+except-in
+  combine-in
+    lens/private/base/main
+    lens/private/compound/main
+  gen:lens
+  focus-lens
+  use-applicable-lenses!

lens-common/lens/private/base/base.rkt

@@ -0,0 +1,11 @@
+#lang racket/base
+(require reprovide/reprovide)
+(reprovide (except-in "gen-lens.rkt" gen-lens/c) "make-lens.rkt" "contract.rkt")
+(module+ test
+  (require rackunit racket/list)
+  (define (set-first l v)
+    (list* v (rest l)))
+  (define first-lens (make-lens first set-first))
+  (let-lens (view-first setter-first) first-lens '(1 2 3 4 5)
+    (check-eqv? view-first 1)
+    (check-equal? (setter-first 'a) '(a 2 3 4 5))))

lens-common/lens/private/base/contract.rkt

@@ -0,0 +1,44 @@
+#lang racket/base
+
+(provide lens/c)
+
+(require racket/contract/base
+         unstable/contract
+         "gen-lens.rkt"
+         )
+(module+ test
+  (require rackunit
+           racket/contract/region
+           fancy-app
+           "make-lens.rkt"
+           ))
+
+(define (lens/c target/c view/c)
+  (rename-contract
+   (gen-lens/c
+    [lens-view (or/c #f [lens? target/c . -> . view/c])]
+    [lens-set (or/c #f [lens? target/c view/c . -> . target/c])]
+    [focus-lens (or/c #f [lens? target/c . -> . (values view/c [view/c . -> . target/c])])])
+   `(lens/c ,(contract-name target/c) ,(contract-name view/c))))
+
+(module+ test
+  (check-exn exn:fail:contract?
+             (λ ()
+               (define/contract lns (lens/c any/c any/c) #f)
+               (void)))
+  (define/contract lns (lens/c hash? string?)
+    (make-lens (hash-ref _ 'a) (hash-set _ 'a _)))
+  (check-equal? (lens-view lns (hash 'a "alpha" 'b "bet"))
+                "alpha")
+  (check-equal? (lens-set lns (hash 'a "alpha" 'b "bet") "alfa")
+                (hash 'a "alfa" 'b "bet"))
+  (let-lens [tgt ctxt] lns (hash 'a "alpha" 'b "bet")
+    (check-equal? tgt "alpha")
+    (check-equal? (ctxt "alfa") (hash 'a "alfa" 'b "bet"))
+    (check-exn exn:fail:contract?
+               (λ () (ctxt 'alpha))))
+  (check-exn exn:fail:contract?
+             (λ () (lens-view lns (hash 'a 'alpha 'b 'bet))))
+  (check-exn exn:fail:contract?
+             (λ () (lens-set lns (hash 'a "alpha" 'b "bet") 'alpha)))
+  )

lens-common/lens/private/base/gen-lens.rkt

@@ -0,0 +1,56 @@
+#lang racket/base
+
+(require racket/contract/base)
+(provide gen:lens
+         let-lens
+         (rename-out [lens/c gen-lens/c])
+         (contract-out 
+                       [lens? predicate/c]
+                       [lens-view (-> lens? any/c any/c)]
+                       [lens-set (-> lens? any/c any/c any/c)]
+                       [focus-lens (-> lens? any/c
+                                       (values any/c (-> any/c any/c)))]
+                       [use-applicable-lenses! (-> void?)]
+                       ))
+
+(require racket/generic fancy-app)
+
+(define-generics lens
+  (lens-view lens target)
+  (lens-set lens target x)
+  (focus-lens lens target)
+  #:defined-predicate lens-implements?
+  #:fallbacks
+  [(define/generic gen-lens-view lens-view)
+   (define/generic gen-lens-set lens-set)
+   (define/generic gen-focus-lens focus-lens)
+   (define (lens-view lens target)
+     (unless (lens-implements? lens 'focus-lens)
+       (error 'lens-view "not implemented for ~v" lens))
+     (let-values ([(view _) (gen-focus-lens lens target)])
+       view))
+   (define (lens-set lens target x)
+     (unless (lens-implements? lens 'focus-lens)
+       (error 'lens-set "not implemented for ~v" lens))
+     (let-values ([(_ setter) (gen-focus-lens lens target)])
+       (setter x)))
+   (define (focus-lens lens target)
+     (unless (lens-implements? lens 'lens-view 'lens-set)
+       (error 'focus-lens "not implemented for ~v" lens))
+     (values (gen-lens-view lens target)
+             (gen-lens-set lens target _)))]
+  #:derive-property prop:procedure
+  (lambda (this target)
+    (if (lenses-applicable?)
+        (lens-view this target)
+        (error "cannot apply a non-applicable lens as a function"))))
+
+(define lenses-applicable? (make-parameter #f))
+
+(define (use-applicable-lenses!)
+  (lenses-applicable? #t))
+
+(define-syntax-rule (let-lens (view context) lens-expr target-expr body ...)
+  (let-values ([(view context) (focus-lens lens-expr target-expr)])
+    body ...))
+

lens-common/lens/private/base/main.rkt

@@ -0,0 +1,4 @@
+#lang reprovide
+lens/private/base/base
+"view-set.rkt"
+"transform.rkt"

lens-common/lens/private/base/make-lens.rkt

@@ -0,0 +1,34 @@
+#lang racket/base
+
+(require racket/contract/base)
+(provide (contract-out [make-lens (-> (-> any/c any/c)
+                                      (-> any/c any/c any/c)
+                                      lens?)]))
+
+(require "gen-lens.rkt")
+
+(module+ test
+  (require rackunit racket/list racket/function))
+
+(struct lens-struct (get set)
+  #:methods gen:lens
+  [(define (lens-view this target)
+     ((lens-struct-get this) target))
+   (define (lens-set this target x)
+     ((lens-struct-set this) target x))]
+  #:methods gen:custom-write
+  [(define (write-proc this out mode)
+     (write-string "#<lens>" out))])
+
+(define (make-lens getter setter)
+  (lens-struct getter setter))
+
+(module+ test
+  (define (set-first l v)
+    (list* v (rest l)))
+  (define first-lens (make-lens first set-first))
+  (check-exn exn:fail? (thunk (first-lens '(a b c))))
+  (let-lens (view-first setter-first) first-lens '(1 2 3 4 5)
+    (check-eqv? view-first 1)
+    (check-equal? (setter-first 'a) '(a 2 3 4 5)))
+  (check-equal? (format "~v" first-lens) "#<lens>"))

lens-common/lens/private/base/transform.rkt

@@ -1,11 +1,14 @@
-#lang racket
+#lang racket/base
 
 (require unstable/sequence
-         "base.rkt"
+         racket/match
+         racket/contract/base
+         lens/private/base/base
          "../util/list-pair-contract.rkt")
 
 (module+ test
   (require rackunit
+           racket/list
            fancy-app))
 
 (provide

lens-common/lens/private/base/view-set.rkt

@@ -1,28 +1,22 @@
-#lang racket
+#lang racket/base
 
 (require unstable/sequence
+         racket/match
+         racket/contract/base
          fancy-app
-         "base.rkt"
+         lens/private/base/base
          "../util/list-pair-contract.rkt")
 
 (module+ test
-  (require rackunit))
+  (require rackunit racket/list))
 
 (provide
- (contract-out [lens-view (-> lens? any/c any/c)]
-               [lens-view/list (->* (any/c) #:rest (listof lens?) list?)]
-               [lens-set (-> lens? any/c any/c any/c)]
+ lens-view
+ lens-set
+ (contract-out [lens-view/list (->* (any/c) #:rest (listof lens?) list?)]
                [lens-set/list (->* (any/c) #:rest (listof2 lens? any/c) any/c)]))
 
 
-(define (lens-view lens target)
-  (let-lens (view _) lens target
-    view))
-
-(define (lens-set lens target x)
-  (let-lens (_ setter) lens target
-    (setter x)))
-
 (define (lens-view/list target . lenses)
   (map (lens-view _ target) lenses))
 

lens-common/lens/private/common/applicable.rkt

@@ -0,0 +1,19 @@
+#lang racket/base
+
+(require reprovide/reprovide)
+(reprovide lens/common)
+
+(require (only-in lens/private/base/base use-applicable-lenses!))
+
+(module+ test
+  (require rackunit))
+
+(use-applicable-lenses!)
+
+(module+ test
+  (define (set-car p a)
+    (cons a (cdr p)))
+  (define car-lens (make-lens car set-car))
+  (check-equal? (car-lens '(a b c)) 'a)
+  (check-equal? (lens-view car-lens '(a b c)) 'a)
+  (check-equal? (lens-set car-lens '(a b c) 97) '(97 b c)))

lens-common/lens/private/compound/arrow.rkt

@@ -7,7 +7,8 @@
          lens-set/thrush
          lens-transform/thrush)
 
-(require lens)
+(require lens/private/base/main
+         lens/private/compound/main)
 
 (module+ test
   (require rackunit racket/list fancy-app))

lens-common/lens/private/compound/compose.rkt

@@ -1,15 +1,21 @@
-#lang racket/base
+#lang sweet-exp racket/base
 
-(require racket/contract
+require racket/contract
         racket/list
+        racket/match
         fancy-app
-         "../base/main.rkt")
+        "../base/main.rkt"
+        "../util/rest-contract.rkt"
+        "identity.rkt"
 
-(module+ test
-  (require rackunit))
+module+ test
+  require rackunit
+          racket/set
+          "../test-util/test-lens.rkt"
 
-(provide
- (contract-out [lens-compose (->* () () #:rest (listof lens?) lens?)]))
+provide
+  contract-out
+    lens-compose (rest-> lens? lens?)
 
 
 (define (lens-compose2 sub-lens super-lens)
@@ -22,11 +28,11 @@
   (make-lens get set))
 
 
-(define lens-compose
-  (compose (foldr lens-compose2 identity-lens _) list))
+(define (lens-compose . args)
+  (foldr lens-compose2 identity-lens args))
 
 
-(module+ test
+module+ test
   (define (set-first l v)
     (list* v (rest l)))
   (define first-lens (make-lens first set-first))
@@ -35,5 +41,6 @@
   (define second-lens (make-lens second set-second))
   (define test-alist '((a 1) (b 2) (c 3)))
   (define first-of-second-lens (lens-compose first-lens second-lens))
-  (check-equal? (lens-view first-of-second-lens test-alist) 'b)
-  (check-equal? (lens-set first-of-second-lens test-alist 'B) '((a 1) (B 2) (c 3))))
+  (check-lens-view first-of-second-lens test-alist 'b)
+  (check-lens-set first-of-second-lens test-alist 'B '((a 1) (B 2) (c 3)))
+  (check-eq? (lens-compose) identity-lens)

lens-common/lens/private/compound/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)
+

lens-common/lens/private/compound/identity.rkt

@@ -0,0 +1,23 @@
+#lang sweet-exp racket/base
+
+require racket/function
+        racket/contract/base
+        "../base/main.rkt"
+        lens/private/isomorphism/base
+
+module+ test
+  require rackunit
+          "../base/main.rkt"
+          "../test-util/test-lens.rkt"
+
+provide
+  contract-out
+    identity-lens lens?
+
+
+(define identity-lens
+  (make-isomorphism-lens identity identity))
+
+(module+ test
+  (check-lens-view identity-lens 'foo 'foo)
+  (check-lens-set identity-lens 'foo 'bar 'bar))

lens-common/lens/private/compound/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/main))
+
+(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))
+  )

lens-common/lens/private/compound/lazy.rkt

@@ -0,0 +1,32 @@
+#lang sweet-exp racket/base
+
+provide lazy-lens
+        rec-lens
+
+require fancy-app lens/private/base/main racket/promise
+module+ test
+  require rackunit
+          lens/private/compound/if
+          lens/private/isomorphism/data
+          lens/private/list/map
+
+(define-syntax-rule (lazy-lens expr)
+  (let ([p (delay expr)])
+    (make-lens (lens-view (force p) _) (lens-set (force p) _ _))))
+
+(define-syntax-rule (rec-lens name expr)
+  (letrec ([name (lazy-lens expr)])
+    name))
+
+module+ test
+  (define (tree-map-lens item-lens)
+    (rec-lens the-tree-lens
+      (lens-cond [list? (map-lens the-tree-lens)]
+                 [else item-lens])))
+  (check-equal? (lens-view (tree-map-lens symbol->string-lens) '(a (b (() c)) (d)))
+                '("a" ("b" (() "c")) ("d")))
+  (check-equal? (lens-set (tree-map-lens symbol->string-lens)
+                          '(a (b (() c)) (d))
+                          '("hay" ("bee" (() "sea")) ("deep")))
+                '(hay (bee (() sea)) (deep)))
+

lens-common/lens/private/compound/main.rkt

@@ -0,0 +1,4 @@
+#lang reprovide
+"compose.rkt"
+"identity.rkt"
+"thrush.rkt"

lens-common/lens/private/compound/thrush.rkt

@@ -8,7 +8,7 @@
 
 (module+ test
   (require rackunit
-           "../list/list-ref-take-drop.rkt"))
+           "../test-util/test-lens.rkt"))
 
 (provide
  (contract-out [lens-thrush (->* () () #:rest (listof lens?) lens?)]))
@@ -26,5 +26,5 @@
   (define second-lens (make-lens second set-second))
   (define test-alist '((a 1) (b 2) (c 3)))
   (define first-of-second-lens (lens-thrush second-lens first-lens))
-  (check-equal? (lens-view first-of-second-lens test-alist) 'b)
-  (check-equal? (lens-set first-of-second-lens test-alist 'B) '((a 1) (B 2) (c 3))))
+  (check-lens-view first-of-second-lens test-alist 'b)
+  (check-lens-set first-of-second-lens test-alist 'B '((a 1) (B 2) (c 3))))

lens-common/lens/private/compound/zoom.rkt

@@ -0,0 +1,104 @@
+#lang sweet-exp racket/base
+
+require racket/contract/base
+provide
+  contract-out
+    lens-zoom (-> lens? lens? lens?)
+    lens-zoom* (->* [] #:rest (listof2 lens? lens?) lens?)
+
+require fancy-app
+        lens/private/base/main
+        lens/private/compound/thrush
+        lens/private/util/list-pair-contract
+        racket/match
+        unstable/sequence
+        lens/private/isomorphism/base
+module+ test
+  require lens/private/list/main
+          rackunit
+          lens/private/isomorphism/data
+          lens/private/list/map
+
+;; lens-zoom : (Lens (Outer Inner) Inner) (Lens A B) -> (Lens (Outer A) (Outer B))
+(define (lens-zoom zoom-lens transformer-lens)
+  (match transformer-lens
+    [(make-isomorphism-lens transformer inverse)
+     ;; transformer : A -> B
+     ;; inverse     : B -> A
+     (make-isomorphism-lens
+      (lens-transform zoom-lens _ transformer) ; (Outer A) -> (Outer B)
+      (lens-transform zoom-lens _ inverse))]   ; (Outer B) -> (Outer A)
+    [transformer-lens
+     ;; get : (Outer A) -> (Outer B)
+     (define (get tgt)
+       ;; transformer : A -> B
+       (define (transformer a)
+         (lens-view transformer-lens a))
+       (lens-transform zoom-lens tgt transformer))
+     ;; set : (Outer A) (Outer B) -> (Outer A)
+     (define (set tgt nvw)
+       ;; a : A
+       (define a (lens-view zoom-lens tgt))
+       ;; transformer : B -> A
+       (define (transformer b)
+         (lens-set transformer-lens a b))
+       (lens-transform zoom-lens nvw transformer))
+     (make-lens get set)]))
+
+(define (lens-zoom* . lenses/transformers)
+  (apply lens-thrush
+         (for/list ([args (in-slice 2 lenses/transformers)])
+           (apply lens-zoom args))))
+
+module+ test
+  (define first-sym->str
+    (lens-zoom first-lens symbol->string-lens))
+  (check-equal? (lens-view first-sym->str '(a b c))
+                '("a" b c))
+  (check-equal? (lens-set first-sym->str '(a b c) '("a" b c))
+                '(a b c))
+  (check-equal? (lens-set first-sym->str '(a b c) '("z" b c))
+                '(z b c))
+  (check-equal? (lens-set first-sym->str '(a b c) '("z" bee sea))
+                '(z bee sea))
+  (check-equal? (lens-view first-sym->str (lens-set first-sym->str '(a b c) '("z" bee sea)))
+                '("z" bee sea))
+  (define trans-second-first/third-second
+    (lens-zoom* second-lens first-lens third-lens second-lens))
+  (check-equal? (lens-view trans-second-first/third-second '(1 (2 3) (4 5)))
+                '(1 2 5))
+  (check-equal? (lens-set trans-second-first/third-second '(1 (2 3) (4 5)) '(1 2 5))
+                '(1 (2 3) (4 5)))
+  (check-equal? (lens-set trans-second-first/third-second '(1 (2 3) (4 5)) '(1 b 5))
+                '(1 (b 3) (4 5)))
+  (check-equal? (lens-set trans-second-first/third-second '(1 (2 3) (4 5)) '(a b c))
+                '(a (b 3) (4 c)))
+  (check-equal? (lens-view trans-second-first/third-second
+                           (lens-set trans-second-first/third-second '(1 (2 3) (4 5)) '(a b c)))
+                '(a b c))
+  (define (rekey-alist-lens key->new-key-lens)
+    (map-lens (lens-zoom car-lens key->new-key-lens)))
+  (check-equal? (lens-view (rekey-alist-lens symbol->string-lens) '((a . 1) (b . 2) (c . 3)))
+                '(("a" . 1) ("b" . 2) ("c" . 3)))
+  (check-equal? (lens-set (rekey-alist-lens symbol->string-lens)
+                          '((a . 1) (b . 2) (c . 3))
+                          '(("a" . 10) ("b" . 200) ("c" . 3000)))
+                '((a . 10) (b . 200) (c . 3000)))
+  (check-equal? (lens-set (rekey-alist-lens symbol->string-lens)
+                          '((a . 1) (b . 2) (c . 3))
+                          '(("one" . 10) ("two" . 200) ("three" . 3000)))
+                '((one . 10) (two . 200) (three . 3000)))
+  (define (rek+v-alist-lens key->new-key-lens value->new-value-lens)
+    (map-lens (lens-zoom* car-lens key->new-key-lens cdr-lens value->new-value-lens)))
+  (check-equal? (lens-view (rek+v-alist-lens symbol->string-lens number->string-lens)
+                           '((a . 1) (b . 2) (c . 3)))
+                '(("a" . "1") ("b" . "2") ("c" . "3")))
+  (check-equal? (lens-set (rek+v-alist-lens symbol->string-lens number->string-lens)
+                          '((a . 1) (b . 2) (c . 3))
+                          '(("a" . "10") ("b" . "200") ("c" . "3000")))
+                '((a . 10) (b . 200) (c . 3000)))
+  (check-equal? (lens-set (rek+v-alist-lens symbol->string-lens number->string-lens)
+                          '((a . 1) (b . 2) (c . 3))
+                          '(("one" . "10") ("two" . "200") ("three" . "3000")))
+                '((one . 10) (two . 200) (three . 3000)))
+

lens-common/lens/private/isomorphism/base.rkt

@@ -0,0 +1,26 @@
+#lang sweet-exp racket/base
+
+provide isomorphism-lens?
+        isomorphism-lens-inverse
+        rename-out [isomorphism-lens make-isomorphism-lens]
+                   [isomorphism-lenses make-isomorphism-lenses]
+
+require racket/match
+        lens/private/base/gen-lens
+
+
+(struct isomorphism-lens (f inv) #:transparent
+  #:methods gen:lens
+  [(define (lens-view lens tgt)
+     ((isomorphism-lens-f lens) tgt))
+   (define (lens-set lens tgt v)
+     ((isomorphism-lens-inv lens) v))])
+
+(define (isomorphism-lens-inverse lens)
+  (match lens
+    [(isomorphism-lens f inv)
+     (isomorphism-lens inv f)]))
+
+(define (isomorphism-lenses f inv)
+  (values (isomorphism-lens f inv)
+          (isomorphism-lens inv f)))

lens-common/lens/private/isomorphism/compound.rkt

@@ -0,0 +1,33 @@
+#lang sweet-exp racket/base
+
+require racket/contract/base
+provide
+  contract-out
+    isomorphism-compose
+      (rest-> isomorphism-lens? isomorphism-lens?)
+    isomorphism-thrush
+      (rest-> isomorphism-lens? isomorphism-lens?)
+
+require racket/match
+        lens/private/util/rest-contract
+        "base.rkt"
+module+ test
+  require lens/private/base/main
+          lens/private/compound/identity
+          lens/private/isomorphism/data
+          rackunit
+
+(define (isomorphism-compose . args)
+  (match args
+    [(list (make-isomorphism-lens fs invs) ...)
+     (make-isomorphism-lens
+      (apply compose1 fs)
+      (apply compose1 (reverse invs)))]))
+
+(define (isomorphism-thrush . args)
+  (apply isomorphism-compose (reverse args)))
+
+module+ test
+  (define string->vector-lens (isomorphism-thrush string->list-lens list->vector-lens))
+  (check-equal? (lens-view string->vector-lens "abc") #(#\a #\b #\c))
+  (check-equal? (lens-set string->vector-lens "abc" #(#\1 #\2 #\3)) "123")

lens-common/lens/private/test-util/test-lens.rkt

@@ -0,0 +1,47 @@
+#lang racket/base
+
+(require racket/contract
+         rackunit
+         fancy-app
+         lens/private/base/base
+         "../base/view-set.rkt")
+
+(provide
+ (contract-out
+  [check-lens-view     (-> lens? any/c any/c void?)]
+  [check-lens-set      (-> lens? any/c any/c any/c void?)]
+  [check-lens-view-set (-> lens? any/c void?)]
+  [check-lens-set-view (-> lens? any/c any/c void?)]
+  [check-lens-set-set  (-> lens? any/c any/c any/c void?)]
+  [test-lens-laws      (-> lens? any/c any/c any/c void?)]))
+
+
+(define-check (check-lens-view lens target expected-view)
+  (check-equal? (lens-view lens target) expected-view))
+
+(define-check (check-lens-set lens target new-view expected-new-target)
+  (check-equal? (lens-set lens target new-view) expected-new-target))
+
+
+(define-check (check-lens-view-set lens target)
+  (check-lens-set lens target (lens-view lens target)
+                  target
+                  "setting target's view to its own view not equal? to itself"))
+
+(define-check (check-lens-set-view lens target new-view)
+  (check-lens-view lens (lens-set lens target new-view)
+                   new-view
+                   "view of target after setting it's view not equal? to the set view"))
+
+(define-check (check-lens-set-set lens target new-view1 new-view2)
+  (let* ([target* (lens-set lens target new-view1)]
+         [target** (lens-set lens target* new-view2)])
+    (check-lens-view lens target**
+                     new-view2
+                     "view of target after setting its view twice not equal? to second view")))
+
+(define (test-lens-laws lens test-target test-view1 test-view2)
+  (check-lens-view-set lens test-target)
+  (check-lens-set-view lens test-target test-view1)
+  (check-lens-set-view lens test-target test-view2)
+  (check-lens-set-set lens test-target test-view1 test-view2))

lens-common/lens/private/test-util/test-multi.rkt

@@ -0,0 +1,21 @@
+#lang sweet-exp racket/base
+
+provide test-multi*
+
+require racket/match
+        racket/string
+        racket/format
+        syntax/parse/define
+        rackunit
+        for-syntax racket/base
+                   syntax/parse
+
+(define-simple-macro
+  (test-multi* ([test-id:id #:in [test-variant:expr ...]] ...)
+    body ...)
+  #:with [pair-id ...] (generate-temporaries #'[test-id ...])
+  #:with [which-test ...] (generate-temporaries #'[test-id ...])
+  (for* ([pair-id (in-list (list (cons 'test-variant test-variant) ...))] ...)
+    (match-define (cons which-test test-id) pair-id) ...
+    (test-case (string-join (list (format "~a = ~a" 'test-id which-test) ...) ", ")
+      body ...)))

lens-common/lens/private/util/id-append.rkt

@@ -0,0 +1,65 @@
+#lang racket/base
+
+(provide id-append)
+
+(require racket/list
+         racket/syntax
+         syntax/srcloc)
+
+;; orig : Syntax -> Syntax
+(define (orig stx)
+  (syntax-property stx 'original-for-check-syntax #t))
+
+;; Sub-Range-Binder-Prop = (Treeof (Vector Id Nat Nat Real Real Id Nat Nat Real Real))
+;; Binder-Proc = Id -> Sub-Range-Binder-Prop
+
+;; make-binder-proc : Id Nat -> Binder-Proc
+(define ((make-binder-proc base n) id)
+  (vector (syntax-local-introduce id)
+          n (syntax-span base) 0.5 0.5
+          (syntax-local-introduce base)
+          0 (syntax-span base) 0.5 0.5))
+
+;; get-sub-range-binders : Id (Listof Binder-Proc) -> Sub-Range-Binder-Prop
+(define (get-sub-range-binders id binder-procs)
+  (for/list ([binder-proc (in-list binder-procs)])
+    (binder-proc id)))
+
+;; empty-id : Syntax -> Id
+(define (empty-id ctxt)
+  (datum->syntax ctxt '||))
+
+(define appended-id-prop (gensym 'appended-id))
+
+;; id-append : #:context Syntax Identifier ... -> (values Identifier Sub-Range-Binder-Prop)
+;; a wrapper around id-append* that keeps track of identifiers that
+;; are themselves appended from other identifiers
+(define (id-append #:context ctxt . ids)
+  (define ids*
+    (append*
+     (for/list ([id (in-list ids)])
+       ;; appended : (U #false (Listof Id))
+       (define appended (syntax-property id appended-id-prop))
+       (cond [appended appended]
+             [else (list id)]))))
+  (define-values [id sub-range-binders]
+    (apply id-append* #:context ctxt ids*))
+  (values (syntax-property id appended-id-prop ids*)
+          sub-range-binders))
+
+;; id-append* : #:context Syntax Identifier ... -> (values Identifier Sub-Range-Binder-Prop)
+(define (id-append* #:context ctxt . ids)
+  ;; binder-procs : (Listof Binder-Proc)
+  (define-values [id n binder-procs]
+    (for/fold ([id1 (empty-id ctxt)] [n 0] [binder-procs '()])
+              ([id2 (in-list ids)])
+      (values (format-id ctxt "~a~a" id1 id2)
+              (+ n (syntax-span id2))
+              (cons (make-binder-proc id2 n) binder-procs))))
+  (define id* (orig id))
+  (values id*
+          (get-sub-range-binders id* binder-procs)))
+
+
+      
+

lens-data/info.rkt

@@ -0,0 +1,27 @@
+#lang info
+
+(define collection 'multi)
+
+(define deps
+  '("base"
+    "lens-common"
+    "rackunit-lib"
+    "unstable-lib"
+    "unstable-list-lib"
+    "unstable-contract-lib"
+    "fancy-app"
+    "syntax-classes-lib"
+    "struct-update-lib"
+    "kw-make-struct"
+    "reprovide-lang"
+    ))
+
+(define build-deps
+  '("sweet-exp-lib"
+    ))
+
+(define cover-omit-paths
+  '(#rx"info\\.rkt"
+    #rx"main\\.rkt"
+    ))
+

lens-data/lens/data.rkt

@@ -0,0 +1,8 @@
+#lang sweet-exp reprovide
+"data/dict.rkt"
+"data/hash.rkt"
+"data/list.rkt"
+"data/stream.rkt"
+"data/string.rkt"
+"data/struct.rkt"
+"data/vector.rkt"

lens-data/lens/data/dict.rkt

@@ -0,0 +1,2 @@
+#lang reprovide
+lens/private/dict/dict

lens-data/lens/data/hash.rkt

@@ -0,0 +1,2 @@
+#lang reprovide
+lens/private/hash/main

lens-data/lens/data/list.rkt

@@ -0,0 +1,2 @@
+#lang reprovide
+lens/private/list/main

lens-data/lens/data/stream.rkt

@@ -0,0 +1,2 @@
+#lang reprovide
+lens/private/stream/stream

lens-data/lens/data/string.rkt

@@ -0,0 +1,2 @@
+#lang reprovide
+lens/private/string/main

lens-data/lens/data/struct.rkt

@@ -0,0 +1,2 @@
+#lang reprovide
+lens/private/struct/main

lens-data/lens/data/vector.rkt

@@ -0,0 +1,2 @@
+#lang reprovide
+lens/private/vector/main

lens-data/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/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-data/lens/private/dict/dict.rkt

@@ -6,7 +6,7 @@
            (-> any/c (lens/c functional-dict? any/c))]
           ))
 
-(require racket/dict fancy-app "base/main.rkt")
+(require lens/private/base/main lens/private/util/functional-dict racket/dict fancy-app)
 (module+ test
   (require rackunit))
 
@@ -14,9 +14,6 @@
   (make-lens (dict-ref _ key)
              (dict-set _ key _)))
 
-(define (functional-dict? v)
-  (and (dict? v) (dict-can-functional-set? v)))
-
 (module+ test
   (check-equal? (lens-transform/list '((a . 1) (b . 2) (c . 3)) (dict-ref-lens 'a) (* 100 _))
                 '((a . 100) (b . 2) (c . 3))))

lens-data/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-data/lens/private/hash/join-hash.rkt

@@ -0,0 +1,42 @@
+#lang racket/base
+
+(require racket/contract
+         racket/match
+         unstable/sequence
+         fancy-app
+         lens/private/base/main
+         lens/private/util/alternating-list
+         lens/private/util/list-pair-contract
+         "../util/immutable.rkt"
+         "../list/join-list.rkt")
+
+(module+ test
+  (require rackunit
+           "../list/list-ref-take-drop.rkt"
+           lens/private/test-util/test-lens))
+
+(provide
+ (contract-out
+  [lens-join/hash (->* () #:rest (listof2 any/c lens?) (lens/c any/c immutable-hash?))]))
+
+
+(define (keys+values->hash keys vs)
+  (make-immutable-hash (keys+values->assoc-list keys vs)))
+
+(define (lens-join/hash . keys/lenses)
+  (define-values [keys lenses] (alternating-list->keys+values keys/lenses))
+  (define list-lens (apply lens-join/list lenses))
+  (define (get target)
+    (keys+values->hash keys (lens-view list-lens target)))
+  (define (set target new-view-hash)
+    (lens-set list-lens target (map (hash-ref new-view-hash _) keys)))
+  (make-lens get set))
+
+(module+ test
+  (define a-b-lens (lens-join/hash 'b third-lens
+                                   'a first-lens))
+  (check-lens-view a-b-lens '(1 2 3)
+                   (hash 'a 1 'b 3))
+  (check-lens-set a-b-lens '(1 2 3) (hash 'a 100 'b 200)
+                  '(100 2 200)))
+

lens-data/lens/private/hash/main.rkt

@@ -0,0 +1,5 @@
+#lang reprovide
+"nested.rkt"
+"pick.rkt"
+"ref.rkt"
+"join-hash.rkt"

lens-data/lens/private/hash/nested.rkt

@@ -1,9 +1,10 @@
-#lang racket
+#lang racket/base
 
-(require "../base/main.rkt"
-         "../compound/main.rkt"
+(require racket/contract/base
+         lens/private/base/main
+         lens/private/compound/main
+         lens/private/util/rest-contract
          "../util/immutable.rkt"
-         "../util/rest-contract.rkt"
          "ref.rkt")
 
 (module+ test

lens-data/lens/private/hash/pick.rkt

@@ -2,14 +2,14 @@
 
 (require racket/contract
          racket/list
-         "../base/main.rkt"
-         "../compound/join-hash.rkt"
+         lens/private/base/main
+         lens/private/util/rest-contract
+         "../hash/join-hash.rkt"
          "../util/immutable.rkt"
-         "../util/rest-contract.rkt"
          "ref.rkt")
 
 (module+ test
-  (require rackunit))
+  (require rackunit lens/private/test-util/test-lens))
 
 (provide
  (contract-out
@@ -24,7 +24,7 @@
          (append-map hash-ref-lens-and-key ks)))
 
 (module+ test
-  (check-equal? (lens-view (hash-pick-lens 'a 'c) (hash 'a 1 'b 2 'c 3))
+  (check-lens-view (hash-pick-lens 'a 'c) (hash 'a 1 'b 2 'c 3)
                    (hash 'a 1 'c 3))
-  (check-equal? (lens-set (hash-pick-lens 'a 'c) (hash 'a 1 'b 2 'c 3) (hash 'a 4 'c 5))
+  (check-lens-set (hash-pick-lens 'a 'c) (hash 'a 1 'b 2 'c 3) (hash 'a 4 'c 5)
                   (hash 'a 4 'b 2 'c 5)))

lens-data/lens/private/hash/ref.rkt

@@ -2,7 +2,7 @@
 
 (require racket/contract
          fancy-app
-         "../base/main.rkt"
+         lens/private/base/main
          "../util/immutable.rkt")
 
 (module+ test

lens-data/lens/private/isomorphism/data.rkt

@@ -0,0 +1,47 @@
+#lang sweet-exp racket/base
+
+provide string->symbol-lens
+        symbol->string-lens
+        number->string-lens
+        string->number-lens
+        list->vector-lens
+        vector->list-lens
+        list->string-lens
+        string->list-lens
+
+require lens/private/base/main
+        lens/private/util/alternating-list
+        lens/private/isomorphism/base
+
+module+ test
+  require rackunit
+
+
+(define-values [string->symbol-lens symbol->string-lens]
+  (make-isomorphism-lenses string->symbol symbol->string))
+(define-values [number->string-lens string->number-lens]
+  (make-isomorphism-lenses number->string string->number))
+(define-values [list->vector-lens vector->list-lens]
+  (make-isomorphism-lenses list->vector vector->list))
+(define-values [list->string-lens string->list-lens]
+  (make-isomorphism-lenses list->string string->list))
+(define-values [alternating->assoc-list-lens assoc->alternating-list-lens]
+  (make-isomorphism-lenses alternating->assoc-list assoc->alternating-list))
+
+
+(module+ test
+  (test-case "string-symbol"
+    (check-equal? (lens-view string->symbol-lens "a") 'a)
+    (check-equal? (lens-set string->symbol-lens "a" 'b) "b")
+    (check-equal? (lens-view symbol->string-lens 'a) "a")
+    (check-equal? (lens-set symbol->string-lens 'a "b") 'b))
+  (test-case "number-string"
+    (check-equal? (lens-view number->string-lens 5) "5")
+    (check-equal? (lens-set number->string-lens 5 "6") 6)
+    (check-equal? (lens-view string->number-lens "5") 5)
+    (check-equal? (lens-set string->number-lens "5" 6) "6"))
+  (test-case "inverses"
+    (check-equal? (isomorphism-lens-inverse string->symbol-lens) symbol->string-lens)
+    (check-equal? (isomorphism-lens-inverse symbol->string-lens) string->symbol-lens)
+    (check-equal? (isomorphism-lens-inverse number->string-lens) string->number-lens)
+    (check-equal? (isomorphism-lens-inverse string->number-lens) number->string-lens)))

lens-data/lens/private/isomorphism/main.rkt

@@ -0,0 +1,4 @@
+#lang reprovide
+lens/private/isomorphism/base
+lens/private/isomorphism/compound
+"data.rkt"

lens-data/lens/private/list/append.rkt

@@ -0,0 +1,76 @@
+#lang racket/base
+
+(provide append*-lens append*n-lens)
+
+(require "flatten.rkt")
+
+(module+ test
+  (require rackunit lens/common lens/private/test-util/test-lens))
+
+(define (append*n-lens n)
+  (flatten/depth-lens (add1 n)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(module+ test
+  (test-case "append*n-lens"
+    (define append**-lens (append*n-lens 2))
+    (define append***-lens (append*n-lens 3))
+
+    (check-equal? (lens-view append**-lens
+                             (list (list (list) (list 1))
+                                   (list (list 2 3))
+                                   (list)
+                                   (list (list 4) (list) (list 5 6))))
+                  (list 1 2 3 4 5 6))
+    (check-equal? (lens-set append**-lens
+                            (list (list (list) (list 1))
+                                   (list (list 2 3))
+                                   (list)
+                                   (list (list 4) (list) (list 5 6)))
+                            (list 'a 'b 'c 'd 'e 'f))
+                  (list (list (list) (list 'a))
+                        (list (list 'b 'c))
+                        (list)
+                        (list (list 'd) (list) (list 'e 'f))))
+
+    (test-lens-laws append**-lens
+                    (list (list (list) (list 1))
+                          (list (list 2 3))
+                          (list)
+                          (list (list 4) (list) (list 5 6)))
+                    (list 'a 'b 'c 'd 'e 'f)
+                    (list "a" "b" "c" "d" "e" "f"))
+
+    (check-equal? (lens-view append***-lens
+                             (list (list (list) (list (list 1)))
+                                   (list (list (list) (list 2 3)))
+                                   (list)
+                                   (list (list (list 4) (list)) (list) (list (list 5 6)))))
+                  (list 1 2 3 4 5 6))
+    (check-equal? (lens-set append***-lens
+                            (list (list (list) (list (list 1)))
+                                  (list (list (list) (list 2 3)))
+                                  (list)
+                                  (list (list (list 4) (list)) (list) (list (list 5 6))))
+                            (list 'a 'b 'c 'd 'e 'f))
+                  (list (list (list) (list (list 'a)))
+                        (list (list (list) (list 'b 'c)))
+                        (list)
+                        (list (list (list 'd) (list)) (list) (list (list 'e 'f)))))
+
+    (test-lens-laws append**-lens
+                    (list (list (list) (list 1))
+                          (list (list 2 3))
+                          (list)
+                          (list (list 4) (list) (list 5 6)))
+                    (list 'a 'b 'c 'd 'e 'f)
+                    (list "a" "b" "c" "d" "e" "f"))
+    (test-lens-laws append***-lens
+                    (list (list (list) (list (list 1)))
+                          (list (list (list) (list 2 3)))
+                          (list)
+                          (list (list (list 4) (list)) (list) (list (list 5 6))))
+                    (list 'a 'b 'c 'd 'e 'f)
+                    (list "a" "b" "c" "d" "e" "f"))
+    ))

lens-data/lens/private/list/assoc.rkt

@@ -1,5 +1,6 @@
-#lang racket
+#lang racket/base
 
+(require racket/contract/base)
 (provide (contract-out
           [assoc-lens
            (->* (any/c) (#:is-equal? (-> any/c any/c boolean?))
@@ -10,12 +11,11 @@
            (-> any/c (lens/c (listof pair?) any/c))]
           ))
 
-(require racket/list
-         fancy-app
-         "../base/main.rkt")
+(require fancy-app
+         lens/private/base/main)
 
 (module+ test
-  (require rackunit)
+  (require rackunit lens/private/test-util/test-lens)
   (define assoc-list '((a . 1) (b . 2) (c . 3))))
 
 
@@ -45,8 +45,8 @@
 
 (module+ test
   (define assoc-b-lens (assoc-lens 'b))
-  (check-equal? (lens-view assoc-b-lens assoc-list) 2)
-  (check-equal? (lens-set assoc-b-lens assoc-list 200)
+  (check-lens-view assoc-b-lens assoc-list 2)
+  (check-lens-set assoc-b-lens assoc-list 200
                   '((a . 1) (b . 200) (c . 3))))
 
 
@@ -56,8 +56,8 @@
 (module+ test
   (define assv-2-lens (assv-lens 2))
   (define assv-list '((1 . a) (2 . b) (3 . c)))
-  (check-eq? (lens-view assv-2-lens assv-list) 'b)
-  (check-equal? (lens-set assv-2-lens assv-list 'FOO)
+  (check-lens-view assv-2-lens assv-list 'b)
+  (check-lens-set assv-2-lens assv-list 'FOO
                   '((1 . a) (2 . FOO) (3 . c))))
 
 
@@ -67,7 +67,7 @@
 (module+ test
   (define assq-a-lens (assq-lens 'a))
   (define assq-list '((a . 1) (b . 2) (c . 3)))
-  (check-eqv? (lens-view assq-a-lens assq-list) 1)
-  (check-equal? (lens-set assq-a-lens assq-list 100)
+  (check-lens-view assq-a-lens assq-list 1)
+  (check-lens-set assq-a-lens assq-list 100
                   '((a . 100) (b . 2) (c . 3))))
 

lens-data/lens/private/list/cadr-etc.rkt

@@ -2,8 +2,8 @@
 
 (require racket/contract
          syntax/parse/define
-         "../base/main.rkt"
-         "../compound/main.rkt"
+         lens/private/base/main
+         lens/private/compound/main
          "car-cdr.rkt"
          (for-syntax racket/base
                      racket/syntax))

lens-data/lens/private/list/car-cdr.rkt

@@ -1,14 +1,15 @@
-#lang racket
+#lang racket/base
 
+(require racket/contract/base)
 (provide
  (contract-out [car-lens (lens/c pair? any/c)]
                [cdr-lens (lens/c pair? any/c)]))
 
-(require "../base/main.rkt")
+(require lens/private/base/main)
 
 (module+ test
   (require rackunit
-           "../test-util/test-lens.rkt"))
+           lens/private/test-util/test-lens))
 
 
 (define (set-car pair v)
@@ -21,10 +22,10 @@
 (define cdr-lens (make-lens cdr set-cdr))
 
 (module+ test
-  (check-view car-lens '(1 . 2) 1)
-  (check-set car-lens '(1 . 2) 'a '(a . 2))
+  (check-lens-view car-lens '(1 . 2) 1)
+  (check-lens-set car-lens '(1 . 2) 'a '(a . 2))
   (test-lens-laws car-lens '(1 . 2) 'a 'b)
 
-  (check-view cdr-lens '(1 . 2) 2)
-  (check-set cdr-lens '(1 . 2) 'a '(1 . a))
+  (check-lens-view cdr-lens '(1 . 2) 2)
+  (check-lens-set cdr-lens '(1 . 2) 'a '(1 . a))
   (test-lens-laws cdr-lens '(1 . 2) 'a 'b))

lens-data/lens/private/list/flatten.rkt

@@ -0,0 +1,217 @@
+#lang racket/base
+
+(provide append*-lens flatten/depth-lens flatten/depth unflatten/depth)
+
+(require fancy-app lens/common racket/list racket/match)
+
+(module+ test
+  (require rackunit syntax/parse lens/private/test-util/test-lens))
+
+;; (define-type (Listof* A n)
+;;   (cond [(zero? n) A]
+;;         [else (Listof* (Listof A) (sub1 n))]))
+
+;; flatten/depth-lens : (Lens (Listof* Any n) (Listof Any))
+;; where the only valid views are lists with the same length as the
+;; result of (flatten/depth n target)
+(define (flatten/depth-lens n)
+  (make-lens
+   (flatten/depth n _)
+   (unflatten/depth n _ _)))
+
+;; append*-lens : (Lens (Listof (Listof Any)) (Listof Any))
+;; where the only valid views are lists with the same length as the
+;; result of applying append* to the target.
+;; Viewing is equivalent to using append*
+;; Setting restores the structure of the original nested list
+(define append*-lens
+  (flatten/depth-lens 2))
+
+;; flatten/depth : n (Listof* A n) -> (Listof A)
+(define (flatten/depth n structure)
+  (check-structure-depth! n structure)
+  (cond [(zero? n) (list structure)]
+        [else (append*n (sub1 n) structure)]))
+
+;; unflatten/depth : n (Listof* A n) (Listof B) -> (Listof* B n)
+(define (unflatten/depth n structure flattened)
+  (check-structure-depth! n structure)
+  (check-flattened-length! n structure flattened)
+  (cond [(zero? n) (first flattened)]
+        [else (unappend*n (sub1 n) structure flattened)]))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; restore-structure : (Listof (Listof A)) (Listof B) -> (Listof (Listof B))
+;; Takes a list of lists and a list and un-flattens the flattened
+;; argument according to the structure of the structure arguement.
+;; The length of the flattened list must be the same as the length
+;; of (append* structure).
+(define (restore-structure structure flattened)
+  (restore-structure/acc structure flattened (list)))
+
+;; restore-structure/acc : (Listof (Listof A)) (Listof B) (Listof (Listof B)) -> (Listof (Listof B))
+;; Accumulates a reversed version of the result of restore-structure,
+;; then returns an un-reversed version.
+(define (restore-structure/acc structure flattened acc)
+  (match structure
+    [(list)
+     (reverse acc)]
+    [(cons s-lst s-rst)
+     (define-values [f-lst f-rst]
+       (split-at flattened (length s-lst)))
+     (restore-structure/acc s-rst f-rst (cons f-lst acc))]))
+
+;; append*n : n (Listof (Listof* A n)) -> (Listof A)
+(define (append*n n structure)
+  (cond [(zero? n) structure]
+        [else (append*n (sub1 n) (append* structure))]))
+
+;; unappend*n : n (Listof (Listof* A n)) (Listof B) -> (Listof (Listof* B n))
+(define (unappend*n n structure flattened)
+  (cond [(zero? n) flattened]
+        [else (restore-structure
+               structure
+               (unappend*n (sub1 n) (append* structure) flattened))]))
+
+;; list/depth? : Natural Any -> Boolean
+(define (list/depth? n structure)
+  (cond [(zero? n) #true]
+        [else (and (list? structure)
+                   (andmap (list/depth? (sub1 n) _) structure))]))
+
+;; check-structure-depth! : n (Listof* A n) -> Void
+(define (check-structure-depth! depth structure)
+  (unless (list/depth? depth structure)
+    (raise-argument-error 'flatten/depth-lens
+                          (format "a nested list of depth ~v" depth)
+                          structure)))
+
+;; check-flattened-length! : n (Listof* A n) (Listof B) -> Void
+(define (check-flattened-length! depth structure flattened)
+  (unless (= (length (flatten/depth depth structure)) (length flattened))
+    (raise-argument-error 'flatten/depth-lens
+                          (format "a list of length ~v"
+                                  (length (flatten/depth depth structure)))
+                          1
+                          structure
+                          flattened)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(module+ test
+  (test-case "append*-lens"
+    (check-equal? (lens-view append*-lens (list (list 1) (list 2 3) (list)))
+                  (list 1 2 3))
+    (check-equal? (lens-set append*-lens
+                            (list (list 1) (list 2 3) (list))
+                            (list 'a 'b 'c))
+                  (list (list 'a) (list 'b 'c) (list)))
+
+    (check-equal? (lens-transform append*-lens
+                                  (list (list 1) (list 2 3) (list))
+                                  reverse) ; any length-preserving computation
+                  (list (list 3) (list 2 1) (list)))
+
+    (check-exn #rx"expected: a nested list of depth 2\n  given: '\\(5\\)"
+               (λ () (lens-view append*-lens (list 5))))
+    (check-exn #rx"expected: a nested list of depth 2\n  given: '\\(5\\)"
+               (λ () (lens-set append*-lens (list 5) (list 'a))))
+
+    (check-exn #rx"expected: a list of length 3\n  given: '\\(a b\\)"
+               (λ () (lens-set append*-lens (list (list 1) (list 2 3) (list)) (list 'a 'b))))
+
+    (test-lens-laws append*-lens
+                    (list (list 1) (list 2 3) (list))
+                    (list 'a 'b 'c)
+                    (list "a" "b" "c"))
+    )
+  
+  (test-case "(flatten/depth-lens 0) adds a list layer"
+    (define flat0-lens (flatten/depth-lens 0))
+    (check-equal? (lens-view flat0-lens 42) (list 42))
+    (check-equal? (lens-set flat0-lens 42 (list 'a)) 'a)
+    (check-equal? (lens-transform flat0-lens 42 reverse) 42)
+    (test-lens-laws flat0-lens
+                    42
+                    (list 'a)
+                    (list "a")))
+  (test-case "(flatten/depth-lens 1) copies the list"
+    (define flat1-lens (flatten/depth-lens 1))
+    (check-equal? (lens-view flat1-lens (list 1 2 3)) (list 1 2 3))
+    (check-equal? (lens-set flat1-lens (list 1 2 3) (list 'a 'b 'c)) (list 'a 'b 'c))
+    (check-equal? (lens-transform flat1-lens (list 1 2 3) reverse) (list 3 2 1))
+    (test-lens-laws flat1-lens
+                    (list 1 2 3)
+                    (list 'a 'b 'c)
+                    (list "a" "b" "c")))
+  (test-case "(flatten/depth-lens 2) should be equivalent to append*-lens"
+    (define flat2-lens (flatten/depth-lens 2))
+    (check-equal? (lens-view flat2-lens
+                             (list (list 1) (list 2 3) (list)))
+                  (list 1 2 3))
+    (check-equal? (lens-set flat2-lens
+                            (list (list 1) (list 2 3) (list))
+                            (list 'a 'b 'c))
+                  (list (list 'a) (list 'b 'c) (list)))
+    
+    (check-equal? (lens-transform flat2-lens
+                                  (list (list 1) (list 2 3) (list))
+                                  reverse)
+                  (list (list 3) (list 2 1) (list)))
+    
+    (test-lens-laws flat2-lens
+                    (list (list 1) (list 2 3) (list))
+                    (list 'a 'b 'c)
+                    (list "a" "b" "c")))
+  (test-case "(flatten/depth-lens 3) deals with lists of depth 3"
+    (define flat3-lens (flatten/depth-lens 3))
+    (check-equal? (lens-view flat3-lens
+                             (list (list (list) (list 1))
+                                   (list (list 2 3))
+                                   (list)
+                                   (list (list 4) (list) (list 5 6))))
+                  (list 1 2 3 4 5 6))
+    (check-equal? (lens-set flat3-lens
+                            (list (list (list) (list 1))
+                                   (list (list 2 3))
+                                   (list)
+                                   (list (list 4) (list) (list 5 6)))
+                            (list 'a 'b 'c 'd 'e 'f))
+                  (list (list (list) (list 'a))
+                        (list (list 'b 'c))
+                        (list)
+                        (list (list 'd) (list) (list 'e 'f))))
+
+    (check-equal? (lens-transform flat3-lens
+                                  (list (list (list) (list 1))
+                                        (list (list 2 3))
+                                        (list)
+                                        (list (list 4) (list) (list 5 6)))
+                                  reverse)
+                  (list (list (list) (list 6))
+                        (list (list 5 4))
+                        (list)
+                        (list (list 3) (list) (list 2 1))))
+
+    (check-exn #rx"expected: a nested list of depth 3\n *given: '\\(5\\)"
+               (λ () (lens-view flat3-lens (list 5))))
+    (check-exn #rx"expected: a nested list of depth 3\n  given: '\\(5\\)"
+               (λ () (lens-set flat3-lens (list 5) (list 'a))))
+
+    (check-exn #rx"expected: a list of length 6\n  given: '\\(a b\\)"
+               (λ () (lens-set flat3-lens
+                               (list (list (list) (list 1))
+                                     (list (list 2 3))
+                                     (list)
+                                     (list (list 4) (list) (list 5 6)))
+                               (list 'a 'b))))
+    
+    (test-lens-laws flat3-lens
+                    (list (list (list) (list 1))
+                          (list (list 2 3))
+                          (list)
+                          (list (list 4) (list) (list 5 6)))
+                    (list 'a 'b 'c 'd 'e 'f)
+                    (list "a" "b" "c" "d" "e" "f")))
+  )

lens-data/lens/private/list/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/list/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/list-ref-take-drop
+
+(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-data/lens/private/list/join-list.rkt

@@ -0,0 +1,35 @@
+#lang sweet-exp racket/base
+
+require racket/list
+        racket/contract
+        lens/private/base/main
+        lens/private/util/alternating-list
+        lens/private/util/rest-contract
+
+module+ test
+  require rackunit
+          "../list/list-ref-take-drop.rkt"
+          lens/private/test-util/test-lens
+
+provide
+  contract-out
+    lens-join/list (rest-> lens? (lens/c any/c list?))
+
+
+(define (lens-join/list . lenses)
+  (define (get target)
+    (apply lens-view/list target lenses))
+  (define (set target new-views)
+    (apply lens-set/list target (keys+values->alternating-list lenses new-views)))
+  (make-lens get set))
+
+
+(module+ test
+  (define first-third-fifth-lens
+    (lens-join/list first-lens
+                    third-lens
+                    fifth-lens))
+  (check-lens-view first-third-fifth-lens '(a b c d e f)
+                   '(a c e))
+  (check-lens-set first-third-fifth-lens '(a b c d e f) '(1 2 3)
+                  '(1 b 2 d 3 f)))

lens-data/lens/private/list/list-ref-take-drop.rkt

@@ -1,5 +1,6 @@
-#lang racket
+#lang racket/base
 
+(require racket/contract/base)
 (provide
  (contract-out
   [list-ref-lens
@@ -25,12 +26,12 @@
 (require racket/list
          fancy-app
          "../util/improper-list-length.rkt"
-         "../base/main.rkt"
-         "../compound/compose.rkt"
+         lens/private/base/main
+         lens/private/compound/compose
          "car-cdr.rkt")
 
 (module+ test
-  (require rackunit))
+  (require rackunit lens/private/test-util/test-lens))
 
 
 (define (set-take n lst new-head)
@@ -52,8 +53,8 @@
 
 (module+ test
   (define take2-lens (take-lens 2))
-  (check-equal? (lens-view take2-lens '(1 2 3 4 5)) '(1 2))
-  (check-equal? (lens-set take2-lens '(1 2 3 4 5) '(a b)) '(a b 3 4 5)))
+  (check-lens-view take2-lens '(1 2 3 4 5) '(1 2))
+  (check-lens-set take2-lens '(1 2 3 4 5) '(a b) '(a b 3 4 5)))
 
 
 (define (drop-lens n)
@@ -61,8 +62,8 @@
 
 (module+ test
   (define drop2-lens (drop-lens 2))
-  (check-equal? (lens-view drop2-lens '(1 2 3 4 5)) '(3 4 5))
-  (check-equal? (lens-set drop2-lens '(1 2 3 4 5) '(a b c)) '(1 2 a b c)))
+  (check-lens-view drop2-lens '(1 2 3 4 5) '(3 4 5))
+  (check-lens-set drop2-lens '(1 2 3 4 5) '(a b c) '(1 2 a b c)))
 
 
 (define (list-ref-lens i)
@@ -81,13 +82,13 @@
 
 
 (module+ test
-  (check-eqv? (lens-view first-lens  '(1 2 3 4 5)) 1)
-  (check-eqv? (lens-view second-lens '(1 2 3 4 5)) 2)
-  (check-eqv? (lens-view third-lens  '(1 2 3 4 5)) 3)
-  (check-eqv? (lens-view fourth-lens '(1 2 3 4 5)) 4)
-  (check-eqv? (lens-view fifth-lens  '(1 2 3 4 5)) 5)
-  (check-equal? (lens-set first-lens  '(1 2 3 4 5) 'a) '(a 2 3 4 5))
-  (check-equal? (lens-set second-lens '(1 2 3 4 5) 'a) '(1 a 3 4 5))
-  (check-equal? (lens-set third-lens  '(1 2 3 4 5) 'a) '(1 2 a 4 5))
-  (check-equal? (lens-set fourth-lens '(1 2 3 4 5) 'a) '(1 2 3 a 5))
-  (check-equal? (lens-set fifth-lens  '(1 2 3 4 5) 'a) '(1 2 3 4 a)))
+  (check-lens-view first-lens  '(1 2 3 4 5) 1)
+  (check-lens-view second-lens '(1 2 3 4 5) 2)
+  (check-lens-view third-lens  '(1 2 3 4 5) 3)
+  (check-lens-view fourth-lens '(1 2 3 4 5) 4)
+  (check-lens-view fifth-lens  '(1 2 3 4 5) 5)
+  (check-lens-set first-lens  '(1 2 3 4 5) 'a '(a 2 3 4 5))
+  (check-lens-set second-lens '(1 2 3 4 5) 'a '(1 a 3 4 5))
+  (check-lens-set third-lens  '(1 2 3 4 5) 'a '(1 2 a 4 5))
+  (check-lens-set fourth-lens '(1 2 3 4 5) 'a '(1 2 3 a 5))
+  (check-lens-set fifth-lens  '(1 2 3 4 5) 'a '(1 2 3 4 a)))

lens-data/lens/private/list/main.rkt

@@ -0,0 +1,7 @@
+#lang reprovide
+"car-cdr.rkt"
+(except-in "list-ref-take-drop.rkt" drop-lens take-lens)
+"cadr-etc.rkt"
+"multi.rkt"
+"join-list.rkt"
+"assoc.rkt"

lens-data/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-data/lens/private/list/multi.rkt

@@ -1,13 +1,14 @@
 #lang racket/base
 
 (require racket/contract
-         "../base/main.rkt"
-         "../compound/main.rkt"
-         "../util/rest-contract.rkt"
+         lens/private/base/main
+         lens/private/compound/main
+         lens/private/util/rest-contract
+         "join-list.rkt"
          "list-ref-take-drop.rkt")
 
 (module+ test
-  (require rackunit))
+  (require rackunit lens/private/test-util/test-lens))
 
 (provide
  (contract-out
@@ -28,7 +29,7 @@
 
 (module+ test
   (define 1-5-6-lens (list-refs-lens 1 5 6))
-  (check-equal? (lens-view 1-5-6-lens '(a b c d e f g))
+  (check-lens-view 1-5-6-lens '(a b c d e f g)
                    '(b f g))
-  (check-equal? (lens-set 1-5-6-lens '(a b c d e f g) '(1 2 3))
+  (check-lens-set 1-5-6-lens '(a b c d e f g) '(1 2 3)
                   '(a 1 c d e 2 3)))

lens-data/lens/private/list/reverse.rkt

@@ -0,0 +1,32 @@
+#lang sweet-exp racket/base
+
+require racket/contract/base
+
+provide
+  contract-out
+    reverse-lens (lens/c list? list?)
+    last-lens (lens/c list? any/c)
+
+require lens/private/base/main
+        lens/private/list/main
+        lens/private/compound/main
+        lens/private/isomorphism/base
+
+module+ test
+  require rackunit fancy-app
+
+
+(define reverse-lens
+  (make-isomorphism-lens reverse reverse))
+
+module+ test
+  (check-equal? (lens-view reverse-lens '(1 2 3)) '(3 2 1))
+  (check-equal? (lens-transform reverse-lens '(1 2 3) (cons 4 _)) '(1 2 3 4))
+
+
+(define last-lens
+  (lens-thrush reverse-lens first-lens))
+
+module+ test
+  (check-equal? (lens-view last-lens '(1 2 3)) 3)
+  (check-equal? (lens-set last-lens '(1 2 3) 'a) '(1 2 a))

lens-data/lens/private/list/sublist.rkt

@@ -2,8 +2,8 @@
 
 (provide sublist-lens)
 
-(require lens
-         lens/list/list-ref-take-drop)
+(require lens/common
+         lens/private/list/list-ref-take-drop)
 
 (module+ test
   (require rackunit))

lens-data/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)
+  )

lens-data/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-data/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-data/lens/private/stream/stream.rkt

@@ -0,0 +1,77 @@
+#lang sweet-exp racket/base
+
+require racket/contract/base
+
+provide
+  contract-out
+    stream-first-lens (lens/c stream? any/c)
+    stream-rest-lens (lens/c stream? stream?)
+    stream-ref-lens (-> exact-nonnegative-integer? (lens/c stream? any/c))
+
+require racket/stream
+        fancy-app
+        lens/private/base/main
+        lens/private/compound/main
+
+module+ test
+  require rackunit
+          lens/private/test-util/test-lens
+
+
+module+ test
+  (define-check (check-stream-equal? stream1 stream2)
+    (let ([list1 (stream->list stream1)] [list2 (stream->list stream2)])
+      (with-check-info
+       (['actual-list list1] ['expected-list list2])
+       (check-equal? list1 list2))))
+
+
+(define (stream-ref-lens i)
+  (lens-compose stream-first-lens (stream-tail-lens i)))
+
+(define (stream-set-first s v)
+  (stream-cons v (stream-rest s)))
+
+(define (stream-set-rest s rst)
+  (stream-cons (stream-first s) rst))
+
+(define stream-first-lens
+  (make-lens
+   stream-first
+   stream-set-first))
+
+(define stream-rest-lens
+  (make-lens
+   stream-rest
+   stream-set-rest))
+
+(define (stream-tail-lens i)
+  (make-lens
+   (stream-tail _ i)
+   (stream-set-tail _ i _)))
+
+(define (stream-set-tail s i rst)
+  (define rev-fst
+    (for/fold ([rev-fst '()]) ([v (in-stream s)] [_ (in-range i)])
+      (cons v rev-fst)))
+  (for/fold ([rst rst]) ([v (in-list rev-fst)])
+    (stream-cons v rst)))
+
+module+ test
+  (check-lens-view stream-first-lens (stream 'a 'b 'c) 'a)
+  (check-lens-view (stream-ref-lens 2) (stream 'a 'b 'c) 'c)
+  (check-stream-equal? (lens-set stream-first-lens (stream 'a 'b 'c) 1)
+                       (stream 1 'b 'c))
+  (check-stream-equal? (lens-set (stream-ref-lens 2) (stream 'a 'b 'c) 1)
+                       (stream 'a 'b 1))
+
+(define (stream-ref-nested-lens . is)
+  (apply lens-thrush (map stream-ref-lens is)))
+
+module+ test
+  (check-lens-view (stream-ref-nested-lens 1 2 0)
+                   (stream 'a (stream 1 2 (stream 'foo 'bar 'baz) 3 4) 'b 'c 'd)
+                   'foo)
+  (check-lens-set-view (stream-ref-nested-lens 1 2 0)
+                       (stream 'a (stream 1 2 (stream 'foo 'bar 'baz) 3 4) 'b 'c 'd)
+                       'FOO)

lens-data/lens/private/string/join-string.rkt

@@ -0,0 +1,36 @@
+#lang sweet-exp racket/base
+
+require racket/contract
+        lens/private/base/main
+        lens/private/isomorphism/base
+        lens/private/compound/compose
+        lens/private/util/rest-contract
+        "../util/immutable.rkt"
+        "../list/join-list.rkt"
+
+module+ test
+  require rackunit
+          lens/private/test-util/test-lens
+          "../list/list-ref-take-drop.rkt"
+
+provide
+  contract-out
+    lens-join/string (rest-> (lens/c any/c char?) (lens/c any/c immutable-string?))
+
+
+(define (lens-join/string . lenses)
+  (lens-compose list->string-lens (apply lens-join/list lenses)))
+
+(define list->string-lens
+  (make-isomorphism-lens list->immutable-string string->list))
+
+(module+ test
+  (define string-first-third-fifth-lens
+    (lens-join/string first-lens
+                      third-lens
+                      fifth-lens))
+  (check-lens-view string-first-third-fifth-lens '(#\a #\b #\c #\d #\e #\f)
+                   "ace")
+  (check-pred immutable? (lens-view string-first-third-fifth-lens '(#\a #\b #\c #\d #\e #\f)))
+  (check-lens-set string-first-third-fifth-lens '(#\a #\b #\c #\d #\e #\f) "ACE"
+                  '(#\A #\b #\C #\d #\E #\f)))

lens-data/lens/private/string/main.rkt

@@ -0,0 +1,3 @@
+#lang reprovide
+"string.rkt"
+"join-string.rkt"

lens-data/lens/private/string/string-split.rkt

@@ -0,0 +1,72 @@
+#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 'string-split-lens "expected a string, char, or regexp, given: ~v" sep)]))
+  (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 "a b c") '("a" "b" "c"))
+  (check-equal? (lens-set ws-lens "a b c" '("d" "e" "f")) "d e f")
+  (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")
+  ;; this input would violate the lens laws
+  (check-exn (regexp (regexp-quote "expected a string not matching #px\"\\\\s+\", given: \"e f\""))
+             (λ ()
+               (lens-set ws-lens "a b c" '("d" "e f" "g"))))
+
+  (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")
+  ;; this input would violate the lens laws
+  (check-exn (regexp (regexp-quote "expected a string not matching \"\\n\", given: \"2\\n2.5\""))
+             (λ ()
+               (lens-set newline-lens "a,b\nc,d\ne,f,g" '("1" "2\n2.5" "3"))))
+
+  (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")
+  ;; this input would violate the lens laws
+  (check-exn (regexp (regexp-quote "expected a string not matching #\\,, given: \"2,2.5\""))
+             (λ ()
+               (lens-set comma-lens "a,b,c" '("1" "2,2.5" "3"))))
+  )

lens-data/lens/private/string/string.rkt

@@ -11,12 +11,13 @@
           ))
 
 (require fancy-app
-         "base/main.rkt"
-         "util/immutable.rkt"
-         "compound/main.rkt")
+         lens/private/base/main
+         lens/private/compound/main
+         "../util/immutable.rkt"
+         "../string/join-string.rkt")
 
 (module+ test
-  (require rackunit))
+  (require rackunit lens/private/test-util/test-lens))
 
 
 (define (string-ref-lens i)
@@ -33,8 +34,8 @@
          (string-ref s j)))))
 
 (module+ test
-  (check-equal? (lens-view (string-ref-lens 2) "abc") #\c)
-  (check-equal? (lens-set (string-ref-lens 0) "abc" #\A) "Abc"))
+  (check-lens-view (string-ref-lens 2) "abc" #\c)
+  (check-lens-set (string-ref-lens 0) "abc" #\A "Abc"))
 
 
 (define (string-pick-lens . is)
@@ -42,7 +43,7 @@
 
 (module+ test
   (define 1-5-6-lens (string-pick-lens 1 5 6))
-  (check-equal? (lens-view 1-5-6-lens "abcdefg")
+  (check-lens-view 1-5-6-lens "abcdefg"
                    "bfg")
-  (check-equal? (lens-set 1-5-6-lens "abcdefg" "BFG")
+  (check-lens-set 1-5-6-lens "abcdefg" "BFG"
                   "aBcdeFG"))

lens-data/lens/private/string/substring.rkt

@@ -0,0 +1,65 @@
+#lang racket/base
+
+(require racket/function racket/contract/base unstable/contract)
+
+(provide
+ (contract-out
+  [substring-lens (->i ([start exact-nonnegative-integer?]
+                        [end (start) (and/c exact-nonnegative-integer?
+                                            (>=/c start))])
+                       [result (start end)
+                               (lens/c (string-length->=/c end)
+                                       (string-length-=/c (- end start)))])]))
+
+(define (string-length->=/c min)
+  (define (length>=? str)
+    (>= (string-length str) min))
+  (and/c string?
+         (rename-contract length>=?
+                          `(string-length->=/c ,min))))
+
+(define (string-length-=/c n)
+  (define (length=? str)
+    (= (string-length str) n))
+  (and/c string?
+         (rename-contract length=?
+                          `(string-length-=/c ,n))))
+
+(require lens/common)
+
+(module+ test
+  (require rackunit))
+
+(define (set-substring str start end replacement-str)
+  (string-append (substring str 0 start)
+                 replacement-str
+                 (substring str end)))
+
+(module+ test
+  (check-equal? (set-substring "mitten" 0 4 "MITT") "MITTen")
+  (check-equal? (set-substring "mitten" 2 4 "ZZ") "miZZen")
+  (check-equal? (set-substring "mitten" 2 6 "LLER") "miLLER"))
+
+(define (substring-lens start end)
+  (define (substring-lens-getter str)
+    (substring str start end))
+  (define (substring-lens-setter str replacement-str)
+    (set-substring str start end replacement-str))
+  (make-lens substring-lens-getter substring-lens-setter))
+
+(module+ test
+  (check-pred lens? (substring-lens 2 4))
+  (check-equal? (lens-view (substring-lens 2 4) "mitten") "tt")
+  (check-equal? (lens-set (substring-lens 2 4) "mitten" "TT") "miTTen"))
+
+(module+ test
+  (require (submod ".."))
+  (check-exn exn:fail:contract?
+             (thunk (substring-lens -1 5)))  ; Improper substring boundaries
+  (check-exn exn:fail:contract?
+             (thunk (lens-set (substring-lens 2 4) "kitten" "c")))  ; Replacement string is too short
+  (check-exn exn:fail:contract?
+             (thunk (lens-set (substring-lens 2 4) "kitten" "cat")))  ; Replacement string is too long
+  (check-not-exn
+             (thunk (lens-set (substring-lens 2 4) "kitten" "ca")))  ; Replacement string is just right!
+  )

lens-data/lens/private/struct/field.rkt

@@ -2,8 +2,8 @@
 
 (require racket/local
          syntax/parse/define
-         alexis/util/struct
-         "../base/main.rkt"
+         struct-update
+         lens/private/base/main
          (for-syntax racket/base
                      syntax/parse
                      racket/syntax))

lens-data/lens/private/struct/main.rkt

@@ -0,0 +1,5 @@
+#lang sweet-exp reprovide
+"field.rkt"
+except-in "struct.rkt"
+  struct-lenses-out
+  struct+lenses-out

lens-data/lens/private/struct/struct-join.rkt

@@ -0,0 +1,81 @@
+#lang sweet-exp racket/base
+
+provide lens-join/struct
+
+require racket/local
+        racket/match
+        lens/private/base/main
+        kw-make-struct
+        for-syntax racket/base
+                   syntax/parse
+module+ test
+  require rackunit lens/private/hash/main lens/private/test-util/test-multi
+
+(begin-for-syntax
+  (define-splicing-syntax-class field-lenses
+    #:attributes ([lens-expr 1] [lens-id 1] [vw-id 1] [norm 1])
+    [pattern (~seq lens-expr:expr ...)
+      #:with [lens-id ...] (generate-temporaries #'[lens-expr ...])
+      #:with [vw-id ...] (generate-temporaries #'[lens-expr ...])
+      #:with [norm ...] #'[vw-id ...]]
+    [pattern (~seq fst-lens:expr ...+ rst:field-lenses)
+      #:with [fst-lens-id ...] (generate-temporaries #'[fst-lens ...])
+      #:with [fst-vw-id ...] (generate-temporaries #'[fst-lens ...])
+      #:with [lens-expr ...] #'[fst-lens ... rst.lens-expr ...]
+      #:with [lens-id ...] #'[fst-lens-id ... rst.lens-id ...]
+      #:with [vw-id ...] #'[fst-vw-id ... rst.vw-id ...]
+      #:with [norm ...] #'[fst-vw-id ... rst.norm ...]]
+    [pattern (~seq (~seq kw:keyword fst-lens:expr) ...+ rst:field-lenses)
+      #:with [fst-lens-id ...] (generate-temporaries #'[fst-lens ...])
+      #:with [fst-vw-id ...] (generate-temporaries #'[fst-lens ...])
+      #:with [lens-expr ...] #'[fst-lens ... rst.lens-expr ...]
+      #:with [lens-id ...] #'[fst-lens-id ... rst.lens-id ...]
+      #:with [vw-id ...] #'[fst-vw-id ... rst.vw-id ...]
+      #:with [[fst-kw/vw-id ...] ...] #'[[kw fst-vw-id] ...]
+      #:with [norm ...] #'[fst-kw/vw-id ... ... rst.norm ...]]
+    ))
+
+(define-syntax lens-join/struct
+  (lambda (stx)
+    (syntax-parse stx
+      [(lens-join/struct s:id flds:field-lenses)
+       #:with make/kw-form #`(make/kw/derived #,stx s flds.norm ...)
+       #:with [[lens-id/vw-id ...] ...] #'[[flds.lens-id flds.vw-id] ...]
+       #`(local [(define flds.lens-id flds.lens-expr) ...]
+           (make-lens
+            (λ (tgt)
+              (define flds.vw-id (lens-view flds.lens-id tgt))
+              ...
+              make/kw-form)
+            (λ (tgt nvw)
+              (match-define make/kw-form nvw)
+              (lens-set/list tgt lens-id/vw-id ... ...))))])))
+
+(module+ test
+  (struct foo (a b c) #:transparent)
+  (define foo-hash-lens1
+    (lens-join/struct foo
+                      (hash-ref-lens 'a)
+                      (hash-ref-lens 'b)
+                      (hash-ref-lens 'c)))
+  (define foo-hash-lens2
+    (lens-join/struct foo
+                      #:a (hash-ref-lens 'a)
+                      #:b (hash-ref-lens 'b)
+                      #:c (hash-ref-lens 'c)))
+  (define foo-hash-lens3
+    (lens-join/struct foo
+                      #:c (hash-ref-lens 'c)
+                      #:a (hash-ref-lens 'a)
+                      #:b (hash-ref-lens 'b)))
+  (define foo-hash-lens4
+    (lens-join/struct foo
+                      (hash-ref-lens 'a)
+                      #:c (hash-ref-lens 'c)
+                      #:b (hash-ref-lens 'b)))
+  (test-multi* ([foo-hash-lens #:in [foo-hash-lens1 foo-hash-lens2 foo-hash-lens3 foo-hash-lens4]])
+    (check-equal? (lens-view foo-hash-lens (hash 'a 1 'b 2 'c 3))
+                  (foo 1 2 3))
+    (check-equal? (lens-set foo-hash-lens (hash 'a 1 'b 2 'c 3) (foo 10 20 30))
+                  (hash 'a 10 'b 20 'c 30))
+    ))

lens-data/lens/private/struct/struct-list.rkt

@@ -0,0 +1,59 @@
+#lang sweet-exp racket/base
+
+provide struct->list-lens list->struct-lens
+
+require racket/local
+        lens/private/isomorphism/base
+        for-syntax racket/base
+                   racket/list
+                   racket/struct-info
+                   syntax/parse
+module+ test
+  require lens/private/base/base
+          lens/private/test-util/test-lens
+          rackunit
+
+begin-for-syntax
+  (define-syntax-class struct-id
+    #:attributes (info constructor-id [accessor-id 1])
+    [pattern struct-id:id
+             #:attr v (syntax-local-value #'struct-id (λ () #f))
+             #:when (struct-info? (attribute v))
+             #:attr info (extract-struct-info (attribute v))
+             #:with descriptor-id:id (first (attribute info))
+             #:with constructor-id:id (syntax-property (second (attribute info))
+                                                       'disappeared-use
+                                                       (list (syntax-local-introduce #'struct-id)))
+             #:with predicate-id:id (third (attribute info))
+             #:with [accessor-id:id ...] (reverse (fourth (attribute info)))])
+
+(define-syntax struct->list-lens
+  (syntax-parser
+    [(struct->list-lens s:struct-id)
+     #'(local [(define (struct->list struct)
+                 (list (s.accessor-id struct) ...))
+               (define (list->struct list)
+                 (apply s.constructor-id list))]
+         (make-isomorphism-lens struct->list list->struct))]))
+
+(define-syntax list->struct-lens
+  (syntax-parser
+    [(list->struct-lens s:struct-id)
+     #'(isomorphism-lens-inverse (struct->list-lens s))]))
+
+module+ test
+  (struct foo (a b c))
+  ;; foo is opaque, so struct->vector doesn't work
+  (check-equal? (struct->vector (foo 1 2 3)) '#(struct:foo ...))
+  (test-case "without inheritance"
+    (check-equal? (lens-view (struct->list-lens foo) (foo 1 2 3)) '(1 2 3))
+    (check-match (lens-set (struct->list-lens foo) (foo 1 2 3) '(4 5 6)) (foo 4 5 6))
+    (check-match (lens-view (list->struct-lens foo) '(1 2 3)) (foo 1 2 3))
+    (check-equal? (lens-set (list->struct-lens foo) '(1 2 3) (foo 4 5 6)) '(4 5 6)))
+  (struct bar foo (d e))
+  (test-case "inheriting from foo"
+    (check-equal? (lens-view (struct->list-lens bar) (bar 1 2 3 4 5)) '(1 2 3 4 5))
+    (check-match (lens-set (struct->list-lens bar) (bar 1 2 3 4 5) '(6 7 8 9 10)) (bar 6 7 8 9 10))
+    (check-match (lens-view (list->struct-lens bar) '(1 2 3 4 5)) (bar 1 2 3 4 5))
+    (check-equal? (lens-set (list->struct-lens bar) '(1 2 3 4 4) (bar 6 7 8 9 10)) '(6 7 8 9 10)))
+

lens-data/lens/private/struct/struct-nested.rkt

@@ -0,0 +1,50 @@
+#lang racket/base
+
+(require fancy-app
+         lens/common
+         lens/private/struct/main
+         (for-syntax racket/base
+                     syntax/parse))
+
+(module+ test
+  (require rackunit))
+
+(provide struct-nested-lens
+         struct-nested-lens*)
+
+
+(define-syntax struct-nested-lens
+  (syntax-parser
+    [(_ [struct-id:id field-id:id] ...)
+     #'(lens-thrush (struct-lens struct-id field-id) ...)]))
+
+(define-syntax struct-nested-lens*
+  (syntax-parser
+    [(_ struct-id:id field-id:id)
+     #'(struct-lens struct-id field-id)]
+    [(_ struct-id:id both0:id both:id ... field-id:id)
+     #'(lens-thrush (struct-lens struct-id both0)
+                    (struct-nested-lens* both0 both ... field-id))]))
+
+(module+ test
+  (struct game (player level) #:transparent)
+  (struct player (posn stats) #:transparent)
+  (struct posn (x y) #:transparent)
+  (struct combat-stats (health attack) #:transparent)
+  (define the-game (game (player (posn 0 0) (combat-stats 10 1)) 'foo-level))
+
+  (define game-player-health-lens
+    (struct-nested-lens [game player]
+                        [player stats]
+                        [combat-stats health]))
+  (check-equal? (lens-view game-player-health-lens the-game) 10)
+  (check-equal? (lens-set game-player-health-lens the-game 20)
+                (game (player (posn 0 0) (combat-stats 20 1)) 'foo-level))
+  
+  (define game-player-posn-x-lens
+    (struct-nested-lens* game player posn x))
+  (check-equal? (lens-view game-player-posn-x-lens the-game) 0)
+  (check-equal? (lens-set game-player-posn-x-lens the-game 3)
+                (game (player (posn 3 0) (combat-stats 10 1)) 'foo-level)))
+
+ 

lens-data/lens/private/struct/struct.rkt

@@ -0,0 +1,73 @@
+#lang racket/base
+
+(require syntax/parse/define
+         struct-update
+         racket/provide-syntax
+         lens/private/base/main
+         (for-syntax racket/base
+                     syntax/parse
+                     syntax/parse/class/struct-id
+                     racket/syntax
+                     racket/struct-info))
+
+(module+ test
+  (require rackunit
+           fancy-app
+           lens/private/test-util/test-lens))
+
+(provide define-struct-lenses
+         struct/lens
+         struct-lenses-out
+         struct+lenses-out)
+
+
+(define-for-syntax (get-struct-own-accessor-ids struct-id-stx)
+  (syntax-parse struct-id-stx
+    [s:struct-id
+     (attribute s.own-accessor-id)]))
+
+(define-for-syntax (map-format-id lex-context format-str ids)
+  (define (format-one-id id)
+    (format-id lex-context format-str id #:source id))
+  (map format-one-id ids))
+
+(define-for-syntax (struct-get-set-lens-ids struct-id-stx)
+  (define accessor-ids (get-struct-own-accessor-ids struct-id-stx))
+  (define set-ids (map-format-id struct-id-stx "~a-set" accessor-ids))
+  (define lens-ids (map-format-id struct-id-stx "~a-lens" accessor-ids))
+  (list accessor-ids set-ids lens-ids))
+
+(define-syntax define-struct-lenses
+  (syntax-parser
+    [(define-struct-lenses s:id)
+     #:with [(s-fld ...)
+             (s-fld-set ...)
+             (s-fld-lens ...)] (struct-get-set-lens-ids #'s)
+     #'(begin
+         (define-struct-updaters s)
+         (define s-fld-lens (make-lens s-fld s-fld-set))
+         ...)]))
+
+
+(define-simple-macro (struct/lens s:id (field-spec ...) option ...)
+  (begin
+    (struct s (field-spec ...) option ...)
+    (define-struct-lenses s)))
+
+(define-provide-syntax struct-lenses-out
+  (syntax-parser
+    [(struct-lenses-out struct-type:id)
+     #:do [(define accessor-ids (get-struct-own-accessor-ids #'struct-type))]
+     #:with [lens-id ...] (map-format-id #'struct-type "~a-lens" accessor-ids)
+     #'(combine-out lens-id ...)]))
+
+(define-provide-syntax struct+lenses-out
+  (syntax-parser
+    [(struct+lenses-out struct-type:id)
+     #'(combine-out (struct-out struct-type) (struct-lenses-out struct-type))]))
+
+(module+ test
+  (struct/lens foo (a b c d) #:transparent)
+  (check-lens-view foo-b-lens (foo 1 2 3 4) 2)
+  (check-lens-set foo-c-lens (foo 1 2 3 4) 'a (foo 1 2 'a 4))
+  (test-lens-laws foo-a-lens (foo 1 2 3 4) 'a 'b))

lens-data/lens/private/syntax/main.rkt

@@ -0,0 +1,3 @@
+#lang reprovide
+"syntax.rkt"
+"syntax-keyword.rkt"

lens-data/lens/private/syntax/srcloc.rkt

@@ -0,0 +1,269 @@
+#lang sweet-exp racket/base
+
+provide syntax-srcloc-lens
+        syntax-source-lens
+        syntax-line-lens
+        syntax-position-lens
+        syntax-column-lens
+        syntax-span-lens
+        source-location->srcloc-lens
+        source-location->list-lens
+        source-location->vector-lens
+        source-location-source-lens
+        source-location-line-lens
+        source-location-column-lens
+        source-location-position-lens
+        source-location-span-lens
+
+require fancy-app
+        lens/common
+        syntax/parse/define
+        syntax/srcloc
+module+ test
+  require rackunit
+
+(define-simple-macro
+  (define-source-location-lenses [lens-id:id getter:expr update-kw:keyword] ...)
+  (begin
+    (define lens-id
+      (make-lens getter (update-source-location _ update-kw _)))
+    ...))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Syntax
+
+;; syntax-srcloc : Syntax -> Srcloc
+(define (syntax-srcloc stx)
+  (source-location->srcloc stx))
+
+;; syntax-set-source-location : Syntax Source-Location -> Syntax
+(define (syntax-set-source-location stx src)
+  (define stx* (syntax-disarm stx #f))
+  (syntax-rearm
+   (datum->syntax stx*
+                  (syntax-e stx*)
+                  (source-location->list src)
+                  stx*)
+   stx))
+
+(define syntax-srcloc-lens
+  (make-lens
+   syntax-srcloc
+   syntax-set-source-location))
+
+(define-source-location-lenses
+  [syntax-source-lens   syntax-source   #:source]
+  [syntax-line-lens     syntax-line     #:line]
+  [syntax-column-lens   syntax-column   #:column]
+  [syntax-position-lens syntax-position #:position]
+  [syntax-span-lens     syntax-span     #:span])
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Source Locations
+
+;; source-location->srcloc : Source-Location -> Srcloc
+(define (source-location->srcloc src)
+  (build-source-location src))
+
+;; source-location->list : Source-Location -> Source-Location-List
+(define (source-location->list src)
+  (build-source-location-list src))
+
+;; source-location->vector : Source-Location -> Source-Location-Vector
+(define (source-location->vector src)
+  (build-source-location-vector src))
+
+;; replace-source-location : Syntax Source-Location -> Syntax
+;;                           Srcloc Source-Location -> Srcloc
+;;                           Source-Location-List Source-Location -> Source-Location-List
+;;                           Source-Location-Vector Source-Location -> Source-Location-Vector
+;;                           Source-Location Source-Location -> Source-Location
+(define (replace-source-location old new)
+  (update-source-location old
+    #:source (source-location-source new)
+    #:line (source-location-line new)
+    #:column (source-location-column new)
+    #:position (source-location-position new)
+    #:span (source-location-span new)))
+
+(define source-location->srcloc-lens
+  (make-lens
+   source-location->srcloc
+   replace-source-location))
+
+(define source-location->list-lens
+  (make-lens
+   source-location->list
+   replace-source-location))
+
+(define source-location->vector-lens
+  (make-lens
+   source-location->vector
+   replace-source-location))
+
+(define-source-location-lenses
+  [source-location-source-lens   source-location-source   #:source]
+  [source-location-line-lens     source-location-line     #:line]
+  [source-location-column-lens   source-location-column   #:column]
+  [source-location-position-lens source-location-position #:position]
+  [source-location-span-lens     source-location-span     #:span])
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Tests
+
+(module+ test
+  (define-check (check-syntax actual-stx expected-datum expected-srcloc)
+    (check-pred syntax? actual-stx)
+    (check-equal? (syntax->datum actual-stx) expected-datum)
+    (check-equal? (syntax-srcloc actual-stx) expected-srcloc))
+
+  (define a-src (srcloc 'a 12 5 144 9))
+  (define b-src (srcloc 'b 49 7 343 14))
+  (define a-lst (list 'a 12 5 144 9))
+  (define b-lst (list 'b 49 7 343 14))
+  (define a-vec (vector-immutable 'a 12 5 144 9))
+  (define b-vec (vector-immutable 'b 49 7 343 14))
+  (define a (datum->syntax #f (list '+ 1 2 3) a-lst))
+  (define b (datum->syntax #f (list 'define 'x 987) b-lst))
+
+  (test-case "syntax-srcloc-lens"
+    (check-equal? (lens-view syntax-srcloc-lens a) a-src)
+    (check-equal? (lens-view syntax-srcloc-lens b) b-src)
+    (check-syntax (lens-set syntax-srcloc-lens a a-src) (list '+ 1 2 3) a-src)
+    (check-syntax (lens-set syntax-srcloc-lens b b-src) (list 'define 'x 987) b-src)
+    (check-syntax (lens-set syntax-srcloc-lens a b-src) (list '+ 1 2 3) b-src)
+    (check-syntax (lens-set syntax-srcloc-lens b a-src) (list 'define 'x 987) a-src)
+    ;; same thing, but with source-location->srcloc-lens instead of syntax-srcloc-lens
+    (check-equal? (lens-view source-location->srcloc-lens a) a-src)
+    (check-equal? (lens-view source-location->srcloc-lens b) b-src)
+    (check-syntax (lens-set source-location->srcloc-lens a a-src) (list '+ 1 2 3) a-src)
+    (check-syntax (lens-set source-location->srcloc-lens b b-src) (list 'define 'x 987) b-src)
+    (check-syntax (lens-set source-location->srcloc-lens a b-src) (list '+ 1 2 3) b-src)
+    (check-syntax (lens-set source-location->srcloc-lens b a-src) (list 'define 'x 987) a-src)
+    ;; same thing, but with source-location->list-lens
+    (check-equal? (lens-view source-location->list-lens a) a-lst)
+    (check-equal? (lens-view source-location->list-lens b) b-lst)
+    (check-syntax (lens-set source-location->list-lens a a-lst) (list '+ 1 2 3) a-src)
+    (check-syntax (lens-set source-location->list-lens b b-lst) (list 'define 'x 987) b-src)
+    (check-syntax (lens-set source-location->list-lens a b-lst) (list '+ 1 2 3) b-src)
+    (check-syntax (lens-set source-location->list-lens b a-lst) (list 'define 'x 987) a-src)
+    ;; same thing, but with source-location->vector-lens
+    (check-equal? (lens-view source-location->vector-lens a) a-vec)
+    (check-equal? (lens-view source-location->vector-lens b) b-vec)
+    (check-syntax (lens-set source-location->vector-lens a a-vec) (list '+ 1 2 3) a-src)
+    (check-syntax (lens-set source-location->vector-lens b b-vec) (list 'define 'x 987) b-src)
+    (check-syntax (lens-set source-location->vector-lens a b-vec) (list '+ 1 2 3) b-src)
+    (check-syntax (lens-set source-location->vector-lens b a-vec) (list 'define 'x 987) a-src)
+    ;; source-location->srcloc-lens also works with other types of source-locations
+    (check-equal? (lens-view source-location->srcloc-lens a-src) a-src)
+    (check-equal? (lens-view source-location->srcloc-lens b-src) b-src)
+    (check-equal? (lens-view source-location->srcloc-lens a-lst) a-src)
+    (check-equal? (lens-view source-location->srcloc-lens b-lst) b-src)
+    (check-equal? (lens-view source-location->srcloc-lens a-vec) a-src)
+    (check-equal? (lens-view source-location->srcloc-lens b-vec) b-src)
+    (check-equal? (lens-set source-location->srcloc-lens a-src b-src) b-src)
+    (check-equal? (lens-set source-location->srcloc-lens a-lst b-src) b-lst)
+    (check-equal? (lens-set source-location->srcloc-lens a-vec b-src) b-vec)
+    (check-equal? (lens-set source-location->srcloc-lens b-src a-src) a-src)
+    (check-equal? (lens-set source-location->srcloc-lens b-lst a-src) a-lst)
+    (check-equal? (lens-set source-location->srcloc-lens b-vec a-src) a-vec)
+    )
+  (test-case "syntax-source-lens"
+    (check-equal? (lens-view syntax-source-lens a) 'a)
+    (check-equal? (lens-view syntax-source-lens b) 'b)
+    (check-syntax (lens-set syntax-source-lens a "bye.rkt")
+                  (list '+ 1 2 3)
+                  (srcloc "bye.rkt" 12 5 144 9))
+    (check-syntax (lens-set syntax-source-lens b "hellooo.rkt")
+                  (list 'define 'x 987)
+                  (srcloc "hellooo.rkt" 49 7 343 14))
+    ;; same thing, but with source-location-source-lens instead of syntax-source-lens
+    (check-equal? (lens-view source-location-source-lens a) 'a)
+    (check-equal? (lens-view source-location-source-lens b) 'b)
+    (check-syntax (lens-set source-location-source-lens a "bye.rkt")
+                  (list '+ 1 2 3)
+                  (srcloc "bye.rkt" 12 5 144 9))
+    (check-syntax (lens-set source-location-source-lens b "hellooo.rkt")
+                  (list 'define 'x 987)
+                  (srcloc "hellooo.rkt" 49 7 343 14))
+    )
+  (test-case "syntax-line-lens"
+    (check-equal? (lens-view syntax-line-lens a) 12)
+    (check-equal? (lens-view syntax-line-lens b) 49)
+    (check-syntax (lens-set syntax-line-lens a 8)
+                  (list '+ 1 2 3)
+                  (srcloc 'a 8 5 144 9))
+    (check-syntax (lens-set syntax-line-lens b 11)
+                  (list 'define 'x 987)
+                  (srcloc 'b 11 7 343 14))
+    ;; same thing, but with source-location-line-lens instead of syntax-line-lens
+    (check-equal? (lens-view source-location-line-lens a) 12)
+    (check-equal? (lens-view source-location-line-lens b) 49)
+    (check-syntax (lens-set source-location-line-lens a 8)
+                  (list '+ 1 2 3)
+                  (srcloc 'a 8 5 144 9))
+    (check-syntax (lens-set source-location-line-lens b 11)
+                  (list 'define 'x 987)
+                  (srcloc 'b 11 7 343 14))
+    )
+  (test-case "syntax-column-lens"
+    (check-equal? (lens-view syntax-column-lens a) 5)
+    (check-equal? (lens-view syntax-column-lens b) 7)
+    (check-syntax (lens-set syntax-column-lens a 8)
+                  (list '+ 1 2 3)
+                  (srcloc 'a 12 8 144 9))
+    (check-syntax (lens-set syntax-column-lens b 11)
+                  (list 'define 'x 987)
+                  (srcloc 'b 49 11 343 14))
+    ;; same thing, but with source-location-column-lens instead of syntax-column-lens
+    (check-equal? (lens-view source-location-column-lens a) 5)
+    (check-equal? (lens-view source-location-column-lens b) 7)
+    (check-syntax (lens-set source-location-column-lens a 8)
+                  (list '+ 1 2 3)
+                  (srcloc 'a 12 8 144 9))
+    (check-syntax (lens-set source-location-column-lens b 11)
+                  (list 'define 'x 987)
+                  (srcloc 'b 49 11 343 14))
+    )
+  (test-case "syntax-position-lens"
+    (check-equal? (lens-view syntax-position-lens a) 144)
+    (check-equal? (lens-view syntax-position-lens b) 343)
+    (check-syntax (lens-set syntax-position-lens a 233)
+                  (list '+ 1 2 3)
+                  (srcloc 'a 12 5 233 9))
+    (check-syntax (lens-set syntax-position-lens b 610)
+                  (list 'define 'x 987)
+                  (srcloc 'b 49 7 610 14))
+    ;; same thing, but with source-location-position-lens instead of syntax-position-lens
+    (check-equal? (lens-view source-location-position-lens a) 144)
+    (check-equal? (lens-view source-location-position-lens b) 343)
+    (check-syntax (lens-set source-location-position-lens a 233)
+                  (list '+ 1 2 3)
+                  (srcloc 'a 12 5 233 9))
+    (check-syntax (lens-set source-location-position-lens b 610)
+                  (list 'define 'x 987)
+                  (srcloc 'b 49 7 610 14))
+    )
+  (test-case "syntax-span-lens"
+    (check-equal? (lens-view syntax-span-lens a) 9)
+    (check-equal? (lens-view syntax-span-lens b) 14)
+    (check-syntax (lens-set syntax-span-lens a 10)
+                  (list '+ 1 2 3)
+                  (srcloc 'a 12 5 144 10))
+    (check-syntax (lens-set syntax-span-lens b 15)
+                  (list 'define 'x 987)
+                  (srcloc 'b 49 7 343 15))
+    ;; same thing, but with source-location-span-lens instead of syntax-span-lens
+    (check-equal? (lens-view source-location-span-lens a) 9)
+    (check-equal? (lens-view source-location-span-lens b) 14)
+    (check-syntax (lens-set source-location-span-lens a 10)
+                  (list '+ 1 2 3)
+                  (srcloc 'a 12 5 144 10))
+    (check-syntax (lens-set source-location-span-lens b 15)
+                  (list 'define 'x 987)
+                  (srcloc 'b 49 7 343 15))
+    )
+  )

lens-data/lens/private/syntax/stx.rkt

@@ -0,0 +1,419 @@
+#lang racket/base
+
+(provide stx->list-lens
+         stx-map-lens
+         stx-car-lens
+         stx-cdr-lens
+         stx-caar-lens
+         stx-cdar-lens
+         stx-cadr-lens
+         stx-cddr-lens
+         stx-caaar-lens
+         stx-cdaar-lens
+         stx-cadar-lens
+         stx-cddar-lens
+         stx-caadr-lens
+         stx-cdadr-lens
+         stx-caddr-lens
+         stx-cdddr-lens
+         stx-append*-lens
+         stx-flatten/depth-lens
+         stx-append*n-lens
+         )
+
+(require fancy-app lens/common lens/private/list/main racket/list racket/match syntax/stx)
+
+(module+ test
+  (require rackunit syntax/parse lens/private/test-util/test-lens))
+
+;; stx-e : Any -> Any
+(define (stx-e stx)
+  (if (syntax? stx)
+      (syntax-e stx)
+      stx))
+
+;; restore-stx : (case-> [Stx Any -> Stx]
+;;                       [Any Any -> Any])
+(define (restore-stx stx dat)
+  (if (syntax? stx)
+      (datum->syntax stx dat stx stx)
+      dat))
+
+(define stx-e-lens
+  (make-lens
+   stx-e
+   restore-stx)) ; the target will be used as the context
+
+;; stx->list* : (Stx-Listof Any) -> (Listof Any)
+(define (stx->list* stx)
+  (define lst (stx->list stx))
+  ;; lst : (U (Listof Any) False)
+  (unless lst (error 'stx->list* "expected a stx-list, given ~v" stx))
+  ;; lst : (Listof Any)
+  lst)
+
+(define stx->list-lens
+  (make-lens
+   stx->list*
+   restore-stx))
+
+(define (stx-map-lens elt-lens)
+  (make-lens
+   (lens-view/stx-map elt-lens _)
+   (lens-set/stx-map elt-lens _ _)))
+
+(define (lens-view/stx-map lens tgts)
+  (stx-map (lens-view lens _) tgts))
+
+(define (lens-set/stx-map lens tgts new-views)
+  (restore-stx tgts
+    (stx-map (lens-set lens _ _) tgts new-views)))
+
+(define stx-car-lens (lens-thrush stx-e-lens car-lens))
+(define stx-cdr-lens (lens-thrush stx-e-lens cdr-lens))
+(define stx-caar-lens (lens-thrush stx-car-lens stx-car-lens))
+(define stx-cdar-lens (lens-thrush stx-car-lens stx-cdr-lens))
+(define stx-cadr-lens (lens-thrush stx-cdr-lens stx-car-lens))
+(define stx-cddr-lens (lens-thrush stx-cdr-lens stx-cdr-lens))
+(define stx-caaar-lens (lens-thrush stx-caar-lens stx-car-lens))
+(define stx-cdaar-lens (lens-thrush stx-caar-lens stx-cdr-lens))
+(define stx-cadar-lens (lens-thrush stx-cdar-lens stx-car-lens))
+(define stx-cddar-lens (lens-thrush stx-cdar-lens stx-cdr-lens))
+(define stx-caadr-lens (lens-thrush stx-cadr-lens stx-car-lens))
+(define stx-cdadr-lens (lens-thrush stx-cadr-lens stx-cdr-lens))
+(define stx-caddr-lens (lens-thrush stx-cddr-lens stx-car-lens))
+(define stx-cdddr-lens (lens-thrush stx-cddr-lens stx-cdr-lens))
+
+;; stx-append* : (Stx-Listof (Stx-Listof A)) -> (Stx-Listof A)
+(define (stx-append* lol)
+  (append* (stx-map stx->list* lol)))
+
+;; restore-structure : (Stx-Listof (Stx-Listof A)) (Stx-Listof B) -> (Stx-Listof (Stx-Listof B))
+;; Takes a list of lists and a list and un-flattens the flattened
+;; argument according to the structure of the structure arguement.
+;; The length of the flattened list must be the same as the length
+;; of (stx-append* structure).
+(define (restore-structure structure flattened)
+  (match (stx-e structure)
+    [(list)
+     (unless (stx-null? flattened)
+       (error 'stx-append*-lens "flattened list is too long to match the structure"))
+     structure]
+    [(cons s-lst s-rst)
+     (define-values [f-lst f-rst]
+       (stx-split-at flattened (stx-length s-lst)))
+     (restore-stx structure
+       (cons (restore-stx s-lst f-lst)
+             (restore-structure s-rst f-rst)))]))
+
+
+;; stx-flatten/depth-lens : (Lens (Stx-Listof* Any n) (Stx-Listof Any))
+;; where the only valid views are stx-lists with the same length as
+;; the result of (stx-flatten/depth n target)
+(define (stx-flatten/depth-lens n)
+  (make-lens
+   (stx-flatten/depth n _)
+   (stx-unflatten/depth n _ _)))
+
+;; stx-append*-lens : (Lens (Stx-Listof (Stx-Listof Any)) (Stx-Listof Any))
+;; where the only valid views are stx-lists with the same length as
+;; the result of applying stx-append* to the target.
+;; Viewing is equivalent to using stx-append*
+;; Setting restores the structure of the original nested stx-list
+(define stx-append*-lens
+  (stx-flatten/depth-lens 2))
+
+;; stx-flatten/depth : n (Stx-Listof* A n) -> (Stx-Listof A)
+(define (stx-flatten/depth n lst*)
+  (check-structure-depth! n lst*)
+  (cond [(zero? n) (list lst*)]
+        [else (stx-append*n (sub1 n) lst*)]))
+
+;; stx-unflatten/depth : n (Stx-Listof* A n) (Stx-Listof B) -> (Stx-Listof* B n)
+(define (stx-unflatten/depth n lst* lst)
+  (check-structure-depth! n lst*)
+  (check-flattened-length! n lst* lst)
+  (cond [(zero? n)
+         (match-define (list v) (stx->list* lst))
+         v]
+        [else
+         (stx-unappend*n (sub1 n) lst* lst)]))
+
+;; stx-append*n : n (Stx-Listof (Stx-Listof* A n)) -> (Stx-Listof A)
+(define (stx-append*n n lst*)
+  (cond [(zero? n) lst*]
+        [else (stx-append*n (sub1 n) (stx-append* lst*))]))
+
+;; stx-unappend*n : n (Stx-Listof (Stx-Listof* A n)) (Stx-Listof B) -> (Stx-Listof (Stx-Listof* B n))
+(define (stx-unappend*n n lst* lst)
+  (cond [(zero? n) lst]
+        [else (restore-structure
+               lst*
+               (stx-unappend*n (sub1 n) (stx-append* lst*) lst))]))
+
+(define (stx-append*n-lens n)
+  (stx-flatten/depth-lens (add1 n)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; stx-list/depth? : Natural Any -> Boolean
+(define (stx-list/depth? n structure)
+  (cond [(zero? n) #true]
+        [else (and (stx-list? structure)
+                   (stx-andmap (stx-list/depth? (sub1 n) _) structure))]))
+
+;; check-structure-depth! : n (Stx-Listof* A n) -> Void
+(define (check-structure-depth! depth structure)
+  (unless (stx-list/depth? depth structure)
+    (raise-argument-error 'stx-flatten/depth-lens
+                          (format "a nested stx-list of depth ~v" depth)
+                          structure)))
+
+;; check-flattened-length! : n (Stx-Listof* A n) (Stx-Listof B) -> Void
+(define (check-flattened-length! depth structure flattened)
+  (unless (= (stx-length (stx-flatten/depth depth structure)) (stx-length flattened))
+    (raise-argument-error 'stx-flatten/depth-lens
+                          (format "a stx-list of length ~v"
+                                  (stx-length (stx-flatten/depth depth structure)))
+                          1
+                          structure
+                          flattened)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; stx-length : (Stx-Listof A) -> Natural
+(define (stx-length lst)
+  (length (stx->list* lst)))
+
+;; stx-andmap : [A -> Boolean] (Stx-Listof A) -> Boolean
+(define (stx-andmap f lst)
+  (andmap f (stx->list* lst)))
+
+;; stx-split-at : (Stx-Listof A) Natural -> (values (Listof A) (Stx-Listof A))
+(define (stx-split-at lst* pos*)
+  (let loop ([acc (list)] [pos pos*] [lst lst*])
+    (cond [(zero? pos)
+           (values (reverse acc) lst)]
+          [(stx-null? lst)
+           (error 'stx-split-at "index is too large for stx-list\n  index: ~v\n  stx-list: ~v"
+                  pos* lst*)]
+          [else
+           (loop (cons (stx-car lst) acc)
+                 (sub1 pos)
+                 (stx-cdr lst))])))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(module+ test
+  (define a* #'a)
+  (define b* #'b)
+  (define c* #'c)
+  (define 1* #'1)
+  (define 2* #'2)
+  (define 3* #'3)
+  (test-case "syntax-e-lens and stx-e-lens"
+    (check-equal? (lens-view stx-e-lens a*) 'a)
+    (check-equal? (syntax-e (lens-set stx-e-lens a* 1)) 1)
+    (check-equal? (lens-view stx-e-lens 'a) 'a)
+    (check-equal? (lens-set stx-e-lens 'a 1) 1)
+    (check-equal? (lens-view stx-e-lens #`(#,a* #,b* #,c*)) (list a* b* c*))
+    (check-equal? (syntax-e (lens-set stx-e-lens #`(#,a* #,b* #,c*) (list 1* 2* 3*)))
+                  (list 1* 2* 3*))
+    (check-equal? (lens-view stx-e-lens (list a* b* c*)) (list a* b* c*))
+    (check-equal? (lens-set stx-e-lens (list a* b* c*) (list 1* 2* 3*)) (list 1* 2* 3*))
+    )
+  (test-case "stx->list-lens"
+    (check-equal? (lens-view stx->list-lens #`(#,a* #,b* #,c*))
+                  (list a* b* c*))
+    (check-equal? (syntax->list (lens-set stx->list-lens #`(#,a* #,b* #,c*) (list 1* 2* 3*)))
+                  (list 1* 2* 3*))
+    (check-exn #rx"expected a stx-list, given #<syntax.* 5>"
+               (λ () (lens-view stx->list-lens #'5)))
+    )
+  (test-case "(stx-map-lens stx->list-lens)"
+    (check-equal? (lens-view (stx-map-lens stx->list-lens) #`((#,a*) (#,b* #,c*) ()))
+                  (list (list a*) (list b* c*) (list)))
+    (check-equal? (stx-map syntax->list
+                           (lens-set (stx-map-lens stx->list-lens)
+                                     #`((#,a*) (#,b* #,c*) ())
+                                     (list (list 1*) (list 2* 3*) (list))))
+                  (list (list 1*) (list 2* 3*) (list)))
+    )
+  (test-case "stx-car-lens, stx-cdr-lens, etc."
+    (check-equal? (lens-view stx-car-lens #`(#,a* . #,b*)) a*)
+    (check-equal? (lens-view stx-cdr-lens #`(#,a* . #,b*)) b*)
+    (check-equal? (lens-view stx-car-lens (cons a* b*)) a*)
+    (check-equal? (lens-view stx-cdr-lens (cons a* b*)) b*)
+    (check-equal? (syntax-e (lens-set stx-car-lens #`(#,a* . #,b*) 1*)) (cons 1* b*))
+    (check-equal? (syntax-e (lens-set stx-cdr-lens #`(#,a* . #,b*) 1*)) (cons a* 1*))
+    (check-equal? (lens-set stx-car-lens (cons a* b*) 1*) (cons 1* b*))
+    (check-equal? (lens-set stx-cdr-lens (cons a* b*) 1*) (cons a* 1*))
+    (check-equal? (lens-view stx-car-lens #`(#,a* #,b* #,c*)) a*)
+    (check-equal? (lens-view stx-cadr-lens #`(#,a* #,b* #,c*)) b*)
+    (check-equal? (lens-view stx-caddr-lens #`(#,a* #,b* #,c*)) c*)
+    (check-equal? (lens-view stx-car-lens (list a* b* c*)) a*)
+    (check-equal? (lens-view stx-cadr-lens (list a* b* c*)) b*)
+    (check-equal? (lens-view stx-caddr-lens (list a* b* c*)) c*)
+    (check-equal? (syntax-e (lens-set stx-car-lens #`(#,a* #,b* #,c*) 1*)) (list 1* b* c*))
+    (check-equal? (syntax-e (lens-set stx-cadr-lens #`(#,a* #,b* #,c*) 1*)) (list a* 1* c*))
+    (check-equal? (syntax-e (lens-set stx-caddr-lens #`(#,a* #,b* #,c*) 1*)) (list a* b* 1*))
+    (check-equal? (lens-set stx-car-lens (list a* b* c*) 1*) (list 1* b* c*))
+    (check-equal? (lens-set stx-cadr-lens (list a* b* c*) 1*) (list a* 1* c*))
+    (check-equal? (lens-set stx-caddr-lens (list a* b* c*) 1*) (list a* b* 1*))
+    )
+  (test-case "stx-append*-lens"
+    (check-equal? (lens-view stx-append*-lens (list (list 1*) (list 2* 3*) (list)))
+                  (list 1* 2* 3*))
+    (check-equal? (lens-view stx-append*-lens #`((#,1*) (#,2* #,3*) ()))
+                  (list 1* 2* 3*))
+    (check-equal? (lens-set stx-append*-lens
+                            (list (list 1) (list 2 3) (list))
+                            (list 'a 'b 'c))
+                  (list (list 'a) (list 'b 'c) (list)))
+    (check-equal? (map syntax->list
+                       (lens-set stx-append*-lens
+                                 (list #`(#,1*) #`(#,2* #,3*) #`())
+                                 (list a* b* c*)))
+                  (list (list a*) (list b* c*) (list)))
+    (check-equal? (map syntax->list
+                       (syntax-e
+                        (lens-set stx-append*-lens
+                                  #`((#,1*) (#,2* #,3*) ())
+                                  (list a* b* c*))))
+                  (list (list a*) (list b* c*) (list)))
+
+    (check-equal? (lens-transform stx-append*-lens
+                                  (list (list 1) (list 2 3) (list))
+                                  (lambda (lst)
+                                    ;; a length-preserving computation
+                                    (let loop ([acc (list)] [sum 0] [lst lst])
+                                      (match lst
+                                        [(list) (reverse acc)]
+                                        [(cons fst rst)
+                                         (loop (cons (+ sum fst) acc)
+                                               (+ sum fst)
+                                               rst)]))))
+                  (list (list 1) (list 3 6) (list)))
+
+    (check-equal? (map syntax->datum
+                       (syntax-e
+                        (lens-transform
+                         stx-append*-lens
+                         #'(((+ a)) ((- a b) (* c d)) ())
+                         (lambda (lst)
+                           ;; a length-preserving computation
+                           (syntax-parse
+                               (expand #`(#%expression (λ (a b c d) (#%app list #,@lst))))
+                             #:literals (#%plain-lambda #%plain-app list)
+                             [(#%expression (#%plain-lambda (x ...) (#%plain-app list e ...)))
+                              #'[e ...]])))))
+                  (list (list '(#%app + a))
+                        (list '(#%app - a b) '(#%app * c d))
+                        (list)))
+
+    (check-exn #rx"expected: a nested stx-list of depth 2\n  given: '\\(5\\)"
+               (λ () (lens-view stx-append*-lens (list 5))))
+    (check-exn #rx"expected: a nested stx-list of depth 2\n  given: '\\(5\\)"
+               (λ () (lens-set stx-append*-lens (list 5) (list 'a))))
+
+    (check-exn #rx"expected: a stx-list of length 3\n  given: '\\(a b\\)"
+               (λ () (lens-set stx-append*-lens (list (list 1) (list 2 3) (list)) (list 'a 'b))))
+
+    (test-lens-laws stx-append*-lens
+                    (list (list 1) (list 2 3) (list))
+                    (list 'a 'b 'c)
+                    (list "a" "b" "c"))
+    (test-lens-laws stx-append*-lens
+                    (list (list 1*) (list 2* 3*) (list))
+                    (list a* b* c*)
+                    (list "a" "b" "c"))
+    )
+  (test-case "stx-flatten/depth-lens"
+    (define flat0-lens (stx-flatten/depth-lens 0))
+    (define flat1-lens (stx-flatten/depth-lens 1))
+    (define flat2-lens (stx-flatten/depth-lens 2))
+    (define flat3-lens (stx-flatten/depth-lens 3))
+    (define flat4-lens (stx-flatten/depth-lens 4))
+
+    (check-equal? (lens-view flat3-lens
+                             (list (list (list) (list 1))
+                                   (list (list 2 3))
+                                   (list)
+                                   (list (list 4) (list) (list 5 6))))
+                  (list 1 2 3 4 5 6))
+    (check-equal? (lens-set flat3-lens
+                            (list (list (list) (list 1))
+                                   (list (list 2 3))
+                                   (list)
+                                   (list (list 4) (list) (list 5 6)))
+                            (list 'a 'b 'c 'd 'e 'f))
+                  (list (list (list) (list 'a))
+                        (list (list 'b 'c))
+                        (list)
+                        (list (list 'd) (list) (list 'e 'f))))
+
+    (test-lens-laws flat3-lens
+                    (list (list (list) (list 1))
+                          (list (list 2 3))
+                          (list)
+                          (list (list 4) (list) (list 5 6)))
+                    (list 'a 'b 'c 'd 'e 'f)
+                    (list "a" "b" "c" "d" "e" "f"))
+
+    (check-equal? (lens-view flat4-lens
+                             (list (list (list) (list (list 1)))
+                                   (list (list (list) (list 2 3)))
+                                   (list)
+                                   (list (list (list 4) (list)) (list) (list (list 5 6)))))
+                  (list 1 2 3 4 5 6))
+    (check-equal? (lens-set flat4-lens
+                            (list (list (list) (list (list 1)))
+                                  (list (list (list) (list 2 3)))
+                                  (list)
+                                  (list (list (list 4) (list)) (list) (list (list 5 6))))
+                            (list 'a 'b 'c 'd 'e 'f))
+                  (list (list (list) (list (list 'a)))
+                        (list (list (list) (list 'b 'c)))
+                        (list)
+                        (list (list (list 'd) (list)) (list) (list (list 'e 'f)))))
+
+     (check-exn #rx"expected: a nested stx-list of depth 3\n *given: '\\(5\\)"
+               (λ () (lens-view flat3-lens (list 5))))
+    (check-exn #rx"expected: a nested stx-list of depth 3\n  given: '\\(5\\)"
+               (λ () (lens-set flat3-lens (list 5) (list 'a))))
+
+    (check-exn #rx"expected: a stx-list of length 6\n  given: '\\(a b\\)"
+               (λ () (lens-set flat3-lens
+                               (list (list (list) (list 1))
+                                     (list (list 2 3))
+                                     (list)
+                                     (list (list 4) (list) (list 5 6)))
+                               (list 'a 'b))))
+    
+   (test-lens-laws flat0-lens
+                    42
+                    (list 'a)
+                    (list "a"))
+    (test-lens-laws flat1-lens
+                    (list 1 2 3)
+                    (list 'a 'b 'c)
+                    (list "a" "b" "c"))
+    (test-lens-laws flat2-lens
+                    (list (list 1) (list 2 3) (list))
+                    (list 'a 'b 'c)
+                    (list "a" "b" "c"))
+    (test-lens-laws flat3-lens
+                    (list (list (list) (list 1))
+                          (list (list 2 3))
+                          (list)
+                          (list (list 4) (list) (list 5 6)))
+                    (list 'a 'b 'c 'd 'e 'f)
+                    (list "a" "b" "c" "d" "e" "f"))
+    (test-lens-laws flat4-lens
+                    (list (list (list) (list (list 1)))
+                          (list (list (list) (list 2 3)))
+                          (list)
+                          (list (list (list 4) (list)) (list) (list (list 5 6))))
+                    (list 'a 'b 'c 'd 'e 'f)
+                    (list "a" "b" "c" "d" "e" "f"))
+    ))

lens-data/lens/private/syntax/syntax-keyword.rkt

@@ -1,6 +1,7 @@
-#lang racket
+#lang racket/base
 
-(require lens
+(require lens/common
+         racket/contract/base
          fancy-app
          syntax/parse)
 

lens-data/lens/private/syntax/syntax.rkt

@@ -1,9 +1,10 @@
-#lang racket
+#lang racket/base
 
 (require syntax/parse
          rackunit
-         lens
-         (for-syntax racket/syntax
+         lens/common
+         (for-syntax racket/base
+                     racket/syntax
                      syntax/stx
                      syntax/parse))
 
@@ -52,10 +53,11 @@
       [(a ...) (ormap (target-stx target-id) (syntax->list #'(a ...)))]
       [a (and (bound-identifier=? target-id #'a) #'a)]))
   
-  (define template->pattern
-    (syntax-parser #:literals (_)
-      [(a ...) #`(#,@(stx-map template->pattern #'(a ...)))]
-      [_ (generate-temporary)]
+  (define (template->pattern stx)
+    (syntax-parse stx
+      ;; preserve lexical context, source location, and properties
+      [(a ...) (datum->syntax stx (stx-map template->pattern #'(a ...)) stx stx)]
+      [(~literal _) (generate-temporary)]
       [a #'a]))
   
   (define ((template-rebuilder target-id) parse-pattern)

lens-data/lens/private/tests/gen-lens-fallback-loop.rkt

@@ -0,0 +1,31 @@
+#lang racket/base
+(require lens/private/base/gen-lens
+         rackunit
+         racket/function)
+
+(struct bad1 ()
+  #:methods gen:lens [])
+(check-exn #rx"lens-view: not implemented"
+           (thunk (lens-view (bad1) 1)))
+(check-exn #rx"lens-set: not implemented"
+           (thunk (lens-set (bad1) 1 1)))
+(check-exn #rx"focus-lens: not implemented"
+           (thunk (focus-lens (bad1) 1)))
+
+(struct bad2 ()
+  #:methods gen:lens
+  [(define (lens-view this tgt) "something")])
+(check-equal? (lens-view (bad2) 1) "something")
+(check-exn #rx"lens-set: not implemented"
+           (thunk (lens-set (bad2) 1 1)))
+(check-exn #rx"focus-lens: not implemented"
+           (thunk (focus-lens (bad2) 1)))
+
+(struct bad3 ()
+  #:methods gen:lens
+  [(define (lens-set this tgt nvw) tgt)])
+(check-equal? (lens-set (bad3) 1 2) 1)
+(check-exn #rx"lens-view: not implemented"
+           (thunk (lens-view (bad3) 1)))
+(check-exn #rx"focus-lens: not implemented"
+           (thunk (focus-lens (bad3) 1)))

lens-data/lens/private/util/alternating-list.rkt

@@ -0,0 +1,61 @@
+#lang sweet-exp racket/base
+
+provide alternating->assoc-list
+        assoc->alternating-list
+        keys+values->assoc-list
+        assoc-list->keys+values
+        keys+values->alternating-list
+        alternating-list->keys+values
+
+require racket/list
+        racket/match
+        unstable/sequence
+module+ test
+  require rackunit
+
+(define (alternating->assoc-list alternating-list)
+  (for/list ([lst (in-slice 2 alternating-list)])
+    (match-define (list a b) lst)
+    (cons a b)))
+
+(define (assoc->alternating-list alist)
+  (append*
+   (for/list ([(k v) (in-pairs alist)])
+     (list k v))))
+
+(define (keys+values->assoc-list keys values)
+  (map cons keys values))
+
+(define (assoc-list->keys+values alist)
+  (values (map car alist)
+          (map cdr alist)))
+
+(define (keys+values->alternating-list keys values)
+  (append-map list keys values))
+
+(define (alternating-list->keys+values alternating-list)
+  (for/lists (ks vv) ([lst (in-slice 2 alternating-list)])
+    (match-define (list k v) lst)
+    (values k v)))
+
+module+ test
+  (check-equal? (alternating->assoc-list '(a 1 b 2)) '((a . 1) (b . 2)))
+  (check-equal? (alternating->assoc-list '(b 2 a 1)) '((b . 2) (a . 1)))
+  (check-equal? (assoc->alternating-list '((a . 1) (b . 2))) '(a 1 b 2))
+  (check-equal? (assoc->alternating-list '((b . 2) (a . 1))) '(b 2 a 1))
+  (check-equal? (keys+values->assoc-list '(a b) '(1 2)) '((a . 1) (b . 2)))
+  (check-equal? (keys+values->assoc-list '(b a) '(2 1)) '((b . 2) (a . 1)))
+  (check-equal? (keys+values->alternating-list '(a b) '(1 2)) '(a 1 b 2))
+  (check-equal? (keys+values->alternating-list '(b a) '(2 1)) '(b 2 a 1))
+  (let-values ([(ks vs) (assoc-list->keys+values '((a . 1) (b . 2)))])
+    (check-equal? ks '(a b))
+    (check-equal? vs '(1 2)))
+  (let-values ([(ks vs) (assoc-list->keys+values '((b . 2) (a . 1)))])
+    (check-equal? ks '(b a))
+    (check-equal? vs '(2 1)))
+  (let-values ([(ks vs) (alternating-list->keys+values '(a 1 b 2))])
+    (check-equal? ks '(a b))
+    (check-equal? vs '(1 2)))
+  (let-values ([(ks vs) (alternating-list->keys+values '(b 2 a 1))])
+    (check-equal? ks '(b a))
+    (check-equal? vs '(2 1)))

lens-data/lens/private/util/functional-dict.rkt

@@ -0,0 +1,15 @@
+#lang sweet-exp racket/base
+
+provide functional-dict?
+
+require racket/dict
+module+ test
+  require rackunit
+
+(define (functional-dict? v)
+  (and (dict? v) (dict-can-functional-set? v)))
+
+module+ test
+  (check-true (functional-dict? (hash 'a 1 'b 2)))
+  (check-true (functional-dict? '((a . 1) (b . 2))))
+  (check-false (functional-dict? (make-hash '((a . 1) (b . 2)))))

lens-data/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)))

lens-data/lens/private/util/immutable.rkt

@@ -2,6 +2,8 @@
 
 (provide (all-defined-out))
 
+(require racket/vector)
+
 ;; The immutable? predicate only works for strings, byte-strings, vectors, hash-tables, and boxes.
 
 (define (immutable-string? v)
@@ -31,3 +33,6 @@
 (define (build-immutable-vector n f)
   (vector->immutable-vector (build-vector n f)))
 
+(define (immutable-vector-map f v)
+  (vector->immutable-vector (vector-map f v)))
+

lens-data/lens/private/vector/join-vector.rkt

@@ -0,0 +1,37 @@
+#lang sweet-exp racket/base
+
+require racket/contract
+        lens/private/base/main
+        lens/private/isomorphism/base
+        lens/private/compound/compose
+        lens/private/util/rest-contract
+        "../util/immutable.rkt"
+        "../list/join-list.rkt"
+
+module+ test
+  require rackunit
+          lens/private/test-util/test-lens
+          "../list/list-ref-take-drop.rkt"
+
+provide
+  contract-out
+    lens-join/vector (rest-> lens? (lens/c any/c immutable-vector?))
+
+
+(define (lens-join/vector . lenses)
+  (lens-compose list->vector-lens (apply lens-join/list lenses)))
+
+(define list->vector-lens
+  (make-isomorphism-lens list->immutable-vector vector->list))
+
+(module+ test
+  (define vector-first-third-fifth-lens
+    (lens-join/vector first-lens
+                      third-lens
+                      fifth-lens))
+  (check-lens-view vector-first-third-fifth-lens '(a b c d e f)
+                #(a c e))
+  (check-pred immutable? (lens-view vector-first-third-fifth-lens '(a b c d e f)))
+  (check-lens-set vector-first-third-fifth-lens '(a b c d e f) #(1 2 3)
+                  '(1 b 2 d 3 f)))
+

lens-data/lens/private/vector/main.rkt

@@ -0,0 +1,5 @@
+#lang reprovide
+"nested.rkt"
+"pick.rkt"
+"ref.rkt"
+"join-vector.rkt"

lens-data/lens/private/vector/nested.rkt

@@ -1,10 +1,10 @@
 #lang racket/base
 
 (require racket/contract
-         "../base/main.rkt"
-         "../compound/main.rkt"
+         lens/private/base/main
+         lens/private/compound/main
+         lens/private/util/rest-contract
          "../util/immutable.rkt"
-         "../util/rest-contract.rkt"
          "ref.rkt")
 
 (module+ test

lens-data/lens/private/vector/pick.rkt

@@ -1,14 +1,15 @@
 #lang racket/base
 
 (require racket/contract
-         "../base/main.rkt"
-         "../compound/main.rkt"
+         lens/private/base/main
+         lens/private/compound/main
+         lens/private/util/rest-contract
          "../util/immutable.rkt"
-         "../util/rest-contract.rkt"
+         "../vector/join-vector.rkt"
          "ref.rkt")
 
 (module+ test
-  (require rackunit))
+  (require rackunit lens/private/test-util/test-lens))
 
 (provide
  (contract-out
@@ -21,7 +22,7 @@
 
 (module+ test
   (define 1-5-6-lens (vector-pick-lens 1 5 6))
-  (check-equal? (lens-view 1-5-6-lens #(a b c d e f g))
+  (check-lens-view 1-5-6-lens #(a b c d e f g)
                    #(b f g))
-  (check-equal? (lens-set 1-5-6-lens #(a b c d e f g) #(1 2 3))
+  (check-lens-set 1-5-6-lens #(a b c d e f g) #(1 2 3)
                   #(a 1 c d e 2 3)))

lens-data/lens/private/vector/ref.rkt

@@ -2,11 +2,11 @@
 
 (require racket/contract
          fancy-app
-         "../base/main.rkt"
+         lens/private/base/main
          "../util/immutable.rkt")
 
 (module+ test
-  (require rackunit))
+  (require rackunit lens/private/test-util/test-lens))
 
 (provide
  (contract-out
@@ -28,5 +28,5 @@
          (vector-ref v j)))))
 
 (module+ test
-  (check-equal? (lens-view (vector-ref-lens 0) #(a b c)) 'a)
-  (check-equal? (lens-set (vector-ref-lens 2) #(a b c) "C") #(a b "C")))
+  (check-lens-view (vector-ref-lens 0) #(a b c) 'a)
+  (check-lens-set (vector-ref-lens 2) #(a b c) "C" #(a b "C")))

lens-data/lens/private/view-set/set-all.rkt

@@ -1,10 +1,11 @@
-#lang racket
+#lang racket/base
 
-(require lens
+(require lens/common
+         racket/contract/base
          fancy-app)
 
 (module+ test
-  (require rackunit))
+  (require rackunit lens/private/list/main))
 
 (provide
  (contract-out

lens-doc/info.rkt

@@ -0,0 +1,26 @@
+#lang info
+
+(define collection 'multi)
+
+(define deps
+  '("base"
+    "lens-lib"
+    "lens-unstable"
+    "scribble-lib"
+    "reprovide-lang"
+    "jack-scribble-example"
+    ))
+
+(define build-deps
+  '("at-exp-lib"
+    "doc-coverage"
+    "racket-doc"
+    "sweet-exp-lib"
+    ))
+
+(define cover-omit-paths
+  '(#rx".*\\.scrbl"
+    #rx"info\\.rkt"
+    "lens/private/doc-util"
+    ))
+

lens-doc/lens/applicable.scrbl

@@ -1,6 +1,6 @@
 #lang scribble/manual
 
-@(require "doc-util/main.rkt")
+@(require lens/private/doc-util/main)
 
 
 @title{Applicable lenses}
@@ -13,7 +13,7 @@ but enables the use of @italic{applicable lenses}. Applicable lenses
 may be used directly as getter functions, removing the need to use
 @racket[lens-view].
 
-@lenses-applicable-examples[
+@lens-applicable-examples[
   (require lens/applicable)
   (first-lens '(a b c))
   (map first-lens '((1 2 3) (a b c) (100 200 300)))
@@ -21,7 +21,7 @@ may be used directly as getter functions, removing the need to use
 
 Attempting to use non-applicable lenses as functions is an error.
 
-@lenses-examples[
+@lens-examples[
   (require lens)
   (first-lens '(a b c))
 ]

lens-doc/lens/info.rkt

@@ -0,0 +1,4 @@
+#lang info
+
+(define scribblings '(["main.scrbl" (multi-page) (library) "lens"]))
+

lens-doc/lens/main.scrbl

@@ -0,0 +1,25 @@
+#lang scribble/manual
+
+@(require lens/private/doc-util/main)
+
+@title[#:style '(toc)]{Lenses}
+
+@defmodule[lens]
+
+This library includes functions and forms for working with
+@lens-tech{lenses}. A lens is a value that operates on some small piece
+of a larger structure. Think of them as a more general representation
+of getters and setters in object-oriented languages.
+
+@author[@author+email["Jack Firth" "jackhfirth@gmail.com"]
+        @author+email["Alex Knauth" "alexander@knauth.org"]]
+
+source code: @url["https://github.com/jackfirth/lens"]
+
+@stability-notice[unstable/lens]
+
+@local-table-of-contents[]
+
+@include-section["private/scribblings/guide.scrbl"]
+@include-section["private/scribblings/reference.scrbl"]
+@include-section[(lib "unstable/lens/main.scrbl")]

lens-doc/lens/private/base/base.scrbl

@@ -1,6 +1,6 @@
 #lang scribble/manual
 
-@(require "../doc-util/main.rkt")
+@(require lens/private/doc-util/main)
 
 @title{Lens Construction}
 
@@ -16,7 +16,7 @@
   @racket[view/c]. The getter must accept a target and return the
   lens's view. The setter must accept a target and a new view, and
   return a new target with its view replaced with the new view.
-  @lenses-examples[
+  @lens-examples[
     (define (set-first lst v)
       (list* v (rest lst)))
     (set-first '(1 2 3) 'a)
@@ -33,7 +33,7 @@
   the target's view to the new view. The context is conceptually
   a function representing the "hole" formed by abstracting the view
   of the target.
-  @lenses-examples[
+  @lens-examples[
     (let-lens (view context) first-lens '(1 2 3)
       (printf "View is ~a\n" view)
       (context 'a))