Merge pull request #264 from jackfirth/252-feature-substring-lens-squashed

Add substring-lens

unstable/lens/main.rkt

@@ -17,6 +17,7 @@
 "struct-nested.rkt"
 "struct-provide.rkt"
 "sublist.rkt"
+"substring.rkt"
 "syntax.rkt"
 "view-set.rkt"
 "zoom.rkt"

unstable/lens/main.scrbl

@@ -30,6 +30,7 @@ this library being backwards-compatible.
   "struct-nested.scrbl"
   "struct-provide.scrbl"
   "sublist.scrbl"
+  "substring.scrbl"
   "syntax.scrbl"
   "view-set.scrbl"
   "zoom.scrbl"

unstable/lens/substring.rkt

@@ -0,0 +1,65 @@
+#lang racket/base
+
+(require racket/function racket/contract/base unstable/contract)
+
+(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 "mitten" 0 4 "MITT") "MITTen")
+  (check-equal? (set-substring "mitten" 2 4 "ZZ") "miZZen")
+  (check-equal? (set-substring "mitten" 2 6 "LLER") "miLLER"))
+
+(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) "mitten") "tt")
+  (check-equal? (lens-set (substring-lens 2 4) "mitten" "TT") "miTTen"))
+
+(module+ test
+  (require (submod ".."))
+  (check-exn exn:fail:contract?
+             (thunk (substring-lens -1 5)))  ; Improper substring boundaries
+  (check-exn exn:fail:contract?
+             (thunk (lens-set (substring-lens 2 4) "kitten" "c")))  ; Replacement string is too short
+  (check-exn exn:fail:contract?
+             (thunk (lens-set (substring-lens 2 4) "kitten" "cat")))  ; Replacement string is too long
+  (check-not-exn
+             (thunk (lens-set (substring-lens 2 4) "kitten" "ca")))  ; Replacement string is just right!
+  )

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!")
+]}