From 7ab893af5ed30f01ba6ed7b3615f6bbffb9cf784 Mon Sep 17 00:00:00 2001 From: AlexKnauth Date: Sun, 13 Dec 2015 22:55:39 -0500 Subject: [PATCH] move more unstable code to lens/private --- lens/private/list/sublist.rkt | 19 +++++++++ lens/private/string/substring.rkt | 65 ++++++++++++++++++++++++++++++ unstable/lens/sublist.rkt | 21 +--------- unstable/lens/substring.rkt | 67 +------------------------------ 4 files changed, 88 insertions(+), 84 deletions(-) create mode 100644 lens/private/list/sublist.rkt create mode 100644 lens/private/string/substring.rkt diff --git a/lens/private/list/sublist.rkt b/lens/private/list/sublist.rkt new file mode 100644 index 0000000..ba9d411 --- /dev/null +++ b/lens/private/list/sublist.rkt @@ -0,0 +1,19 @@ +#lang racket/base + +(provide sublist-lens) + +(require lens + lens/private/list/list-ref-take-drop) + +(module+ test + (require rackunit)) + +(define (sublist-lens i j) + (lens-thrush (take-lens j) (drop-lens i))) + +(module+ test + (check-equal? (lens-view (sublist-lens 1 4) '(0 1 2 3 4 5)) + '(1 2 3)) + (check-equal? (lens-set (sublist-lens 1 4) '(0 1 2 3 4 5) '(a b c)) + '(0 a b c 4 5)) + ) diff --git a/lens/private/string/substring.rkt b/lens/private/string/substring.rkt new file mode 100644 index 0000000..6965847 --- /dev/null +++ b/lens/private/string/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! + ) \ No newline at end of file diff --git a/unstable/lens/sublist.rkt b/unstable/lens/sublist.rkt index ba9d411..0527d0f 100644 --- a/unstable/lens/sublist.rkt +++ b/unstable/lens/sublist.rkt @@ -1,19 +1,2 @@ -#lang racket/base - -(provide sublist-lens) - -(require lens - lens/private/list/list-ref-take-drop) - -(module+ test - (require rackunit)) - -(define (sublist-lens i j) - (lens-thrush (take-lens j) (drop-lens i))) - -(module+ test - (check-equal? (lens-view (sublist-lens 1 4) '(0 1 2 3 4 5)) - '(1 2 3)) - (check-equal? (lens-set (sublist-lens 1 4) '(0 1 2 3 4 5) '(a b c)) - '(0 a b c 4 5)) - ) +#lang reprovide +lens/private/list/sublist diff --git a/unstable/lens/substring.rkt b/unstable/lens/substring.rkt index 6965847..a3acdf7 100644 --- a/unstable/lens/substring.rkt +++ b/unstable/lens/substring.rkt @@ -1,65 +1,2 @@ -#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! - ) \ No newline at end of file +#lang reprovide +lens/private/string/substring