diff --git a/unstable/lens/main.rkt b/unstable/lens/main.rkt index 9c8fa8e..d725374 100644 --- a/unstable/lens/main.rkt +++ b/unstable/lens/main.rkt @@ -16,6 +16,7 @@ "struct-nested.rkt" "struct-provide.rkt" "sublist.rkt" +"substring.rkt" "syntax.rkt" "view-set.rkt" "zoom.rkt" diff --git a/unstable/lens/main.scrbl b/unstable/lens/main.scrbl index 0fa88ee..1d9ad86 100644 --- a/unstable/lens/main.scrbl +++ b/unstable/lens/main.scrbl @@ -29,6 +29,7 @@ this library being backwards-compatible. "struct-nested.scrbl" "struct-provide.scrbl" "sublist.scrbl" + "substring.scrbl" "syntax.scrbl" "view-set.scrbl" "zoom.scrbl" diff --git a/unstable/lens/substring.rkt b/unstable/lens/substring.rkt new file mode 100644 index 0000000..2eccc20 --- /dev/null +++ b/unstable/lens/substring.rkt @@ -0,0 +1,53 @@ +#lang racket/base + +(require racket/contract/base) + +(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) + +(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 "kitten" 0 4 "KITT") "KITTen") + (check-equal? (set-substring "kitten" 2 6 "ller") "killer") + (check-equal? (set-substring "kitten" 2 4 "ss") "kissen")) + +(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) "kitten") "tt") + (check-equal? (lens-set (substring-lens 2 4) "kitten" "TT") "kiTTen")) diff --git a/unstable/lens/substring.scrbl b/unstable/lens/substring.scrbl new file mode 100644 index 0000000..597fb5d --- /dev/null +++ b/unstable/lens/substring.scrbl @@ -0,0 +1,22 @@ +#lang scribble/manual + +@(require lens/private/doc-util/main) + +@title{Substring Lenses} + +@defproc[(substring-lens [start exact-nonnegative-integer?] + [end exact-nonnegative-integer?]) + (lens/c string? string?)]{ + Creates a lens that views a substring from @racket[start] to @racket[end] + of a given string. @racket[start] is inclusive and @racket[end] is exclusive, + in the same way as for @racket[substring]. + @lens-unstable-examples[ + (lens-view (substring-lens 1 4) "abcdefg") + (lens-set (substring-lens 1 4) "abcdefg" "FOO") + ] + When setting a new view, the replacement string has to be + the same length as the span of the substring lens to uphold + the @seclink["laws"]{lens laws}. + @lens-unstable-examples[ + (lens-set (substring-lens 1 4) "kitten" "this string is too long!") +]} \ No newline at end of file