add vector-mapper-lens

lens/doc-util/lenses-examples.rkt

@@ -18,10 +18,10 @@
 
 
 (define-examples-form lenses-examples
-  lens racket/list racket/stream)
+  lens racket/list racket/vector racket/stream)
 
 (define-examples-form lenses-applicable-examples
-  lens/applicable racket/list racket/stream)
+  lens/applicable racket/list racket/vector racket/stream)
 
 (define-examples-form lenses-unstable-examples
-  lens unstable/lens racket/list racket/stream)
+  lens unstable/lens racket/list racket/vector racket/stream)

lens/doc-util/main.rkt

@@ -7,6 +7,7 @@
                     unstable/lens
                     racket/base
                     racket/list
+                    racket/vector
                     racket/stream
                     racket/contract)
          (for-syntax racket/base
@@ -22,6 +23,7 @@
                      unstable/lens
                      racket/base
                      racket/list
+                     racket/vector
                      racket/stream
                      racket/contract))
          (for-syntax (all-from-out

unstable/lens/mapper.rkt

@@ -1,9 +1,11 @@
 #lang racket/base
 
 (provide mapper-lens
+         vector-mapper-lens
          )
 
 (require lens/base/main
+         racket/vector
          fancy-app
          )
 (module+ test
@@ -20,6 +22,17 @@
 (define (lens-set/map lens tgts new-views)
   (map (lens-set lens _ _) tgts new-views))
 
+(define (vector-mapper-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 (mapper-lens first-lens) '((a b) (c d) (e f)))
                 '(a c e))
@@ -27,4 +40,10 @@
                 '((1 b) (2 d) (3 f)))
   (check-equal? (lens-transform (mapper-lens first-lens) '((a b) (c d) (e f)) (map symbol->string _))
                 '(("a" b) ("c" d) ("e" f)))
+  (check-equal? (lens-view (vector-mapper-lens first-lens) '#((a b) (c d) (e f)))
+                '#(a c e))
+  (check-equal? (lens-set (vector-mapper-lens first-lens) '#((a b) (c d) (e f)) '#(1 2 3))
+                '#((1 b) (2 d) (3 f)))
+  (check-equal? (lens-transform (vector-mapper-lens first-lens) '#((a b) (c d) (e f)) (vector-map symbol->string _))
+                '#(("a" b) ("c" d) ("e" f)))
   )

unstable/lens/mapper.scrbl

@@ -2,7 +2,7 @@
 
 @(require lens/doc-util/main)
 
-@title{Lenses that map over lists}
+@title{Lenses that map over lists and vectors}
 
 @defmodule[unstable/lens/mapper]
 
@@ -13,3 +13,11 @@ Creates a lens that maps @racket[lens] over a target list.
   (lens-set (mapper-lens first-lens) '((a b) (c d) (e f)) '(1 2 3))
   (lens-transform (mapper-lens first-lens) '((a b) (c d) (e f)) (λ (xs) (map symbol->string xs)))
 ]}
+
+@defproc[(vector-mapper-lens [lens lens?]) lens?]{
+Creates a lens that maps @racket[lens] over a target vector with @racket[vector-map].
+@lenses-unstable-examples[
+  (lens-view (vector-mapper-lens first-lens) '#((a b) (c d) (e f)))
+  (lens-set (vector-mapper-lens first-lens) '#((a b) (c d) (e f)) '#(1 2 3))
+  (lens-transform (vector-mapper-lens first-lens) '#((a b) (c d) (e f)) (λ (xs) (vector-map symbol->string xs)))
+]}