Merge pull request #129 from AlexKnauth/lens-join-vector

add lens-join/vector

unstable/lens/join.rkt

@@ -11,7 +11,9 @@
 (provide
  (contract-out
   [lens-join/list (->* () #:rest (listof lens?) lens?)]
-  [lens-join/hash (->* () #:rest (listof2 any/c lens?) lens?)]))
+  [lens-join/hash (->* () #:rest (listof2 any/c lens?) lens?)]
+  [lens-join/vector (->* () #:rest (listof lens?) lens?)]
+  ))
 
 
 (define (zip xs ys)
@@ -71,3 +73,25 @@
                 (hash 'a 1 'b 3))
   (check-equal? (lens-set a-b-lens '(1 2 3) (hash 'a 100 'b 200))
                 '(100 2 200)))
+
+
+(define (lens-join/vector . lenses)
+  (lens-compose list->vector-lens (apply lens-join/list lenses)))
+
+(define (inverse-function-lens f f-inv)
+  (make-lens
+   (λ (tgt) (f tgt))
+   (λ (tgt v) (f-inv v))))
+
+(define list->vector-lens
+  (inverse-function-lens list->vector vector->list))
+
+(module+ test
+  (define vector-first-third-fifth-lens
+    (lens-join/vector first-lens
+                      third-lens
+                      fifth-lens))
+  (check-equal? (lens-view vector-first-third-fifth-lens '(a b c d e f))
+                #(a c e))
+  (check-equal? (lens-set vector-first-third-fifth-lens '(a b c d e f) #(1 2 3))
+                '(1 b 2 d 3 f)))

unstable/lens/join.scrbl

@@ -34,3 +34,14 @@
     (lens-view a-b-lens '(1 2 3))
     (lens-set a-b-lens '(1 2 3) (hash 'a 100 'b 200))
 ]}
+
+@defproc[(lens-join/vector [lens lens?] ...) lens?]{
+  Like @racket[lens-join/list], except the view is a vector, not a list.
+  @lenses-unstable-examples[
+    (define vector-first-third-fifth-lens
+      (lens-join/vector first-lens
+                        third-lens
+                        fifth-lens))
+    (lens-view vector-first-third-fifth-lens '(a b c d e f))
+    (lens-set vector-first-third-fifth-lens '(a b c d e f) #(1 2 3))
+]}