add string stuff

unstable/lens/join.rkt

@@ -13,6 +13,7 @@
   [lens-join/list (->* () #:rest (listof lens?) lens?)]
   [lens-join/hash (->* () #:rest (listof2 any/c lens?) lens?)]
   [lens-join/vector (->* () #:rest (listof lens?) lens?)]
+  [lens-join/string (->* () #:rest (listof lens?) lens?)]
   ))
 
 
@@ -95,3 +96,23 @@
                 #(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)))
+
+(define (lens-join/string . lenses)
+  (lens-compose list->string-lens (apply lens-join/list lenses)))
+
+(define (list->immutable-string lst)
+  (string->immutable-string (list->string lst)))
+
+(define list->string-lens
+  (inverse-function-lens list->immutable-string string->list))
+
+(module+ test
+  (define string-first-third-fifth-lens
+    (lens-join/string first-lens
+                      third-lens
+                      fifth-lens))
+  (check-equal? (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-equal? (lens-set string-first-third-fifth-lens '(#\a #\b #\c #\d #\e #\f) "ACE")
+                '(#\A #\b #\C #\d #\E #\f)))

unstable/lens/join.scrbl

@@ -45,3 +45,15 @@
     (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))
 ]}
+
+@defproc[(lens-join/string [lens lens?] ...) lens?]{
+  Like @racket[lens-join/list], except the view is a string, not a list.
+  Each @racket[lens] argument must return a @racket[char?] as a view.
+  @lenses-unstable-examples[
+    (define string-first-third-fifth-lens
+      (lens-join/string first-lens
+                        third-lens
+                        fifth-lens))
+    (lens-view string-first-third-fifth-lens '(#\a #\b #\c #\d #\e #\f))
+    (lens-set string-first-third-fifth-lens '(#\a #\b #\c #\d #\e #\f) "ACE")
+]}

unstable/lens/string.rkt

@@ -0,0 +1,43 @@
+#lang racket/base
+
+(provide string-ref-lens
+         string-pluck-lens
+         )
+
+(require fancy-app
+         lens/base/main
+         "join.rkt"
+         )
+(module+ test
+  (require rackunit))
+
+(define (string-ref-lens i)
+  (make-lens
+   (string-ref _ i)
+   (string-set _ i _)))
+
+(define (string-set s i c)
+  (string->immutable-string
+   (build-string (string-length s)
+                 (λ (j)
+                   (if (= i j)
+                       c
+                       (string-ref s j))))))
+
+(define (string-pluck-lens . is)
+  (apply lens-join/string (map string-ref-lens is)))
+
+
+(module+ test
+  (check-equal? (lens-view (string-ref-lens 0) "abc") #\a)
+  (check-equal? (lens-view (string-ref-lens 1) "abc") #\b)
+  (check-equal? (lens-view (string-ref-lens 2) "abc") #\c)
+  (check-equal? (lens-set (string-ref-lens 0) "abc" #\A) "Abc")
+  (check-equal? (lens-set (string-ref-lens 1) "abc" #\B) "aBc")
+  (check-equal? (lens-set (string-ref-lens 2) "abc" #\C) "abC")
+  (define 1-5-6-lens (string-pluck-lens 1 5 6))
+  (check-equal? (lens-view 1-5-6-lens "abcdefg")
+                "bfg")
+  (check-equal? (lens-set 1-5-6-lens "abcdefg" "BFG")
+                "aBcdeFG")
+  )