diff --git a/unstable/lens/join.rkt b/unstable/lens/join.rkt index 10c9a21..3420773 100644 --- a/unstable/lens/join.rkt +++ b/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))) diff --git a/unstable/lens/join.scrbl b/unstable/lens/join.scrbl index 6b92582..42574c0 100644 --- a/unstable/lens/join.scrbl +++ b/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") +]} diff --git a/unstable/lens/string.rkt b/unstable/lens/string.rkt new file mode 100644 index 0000000..31ca9ec --- /dev/null +++ b/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") + )