suzanne.soy/lens
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

move more unstable code to lens/private

Browse Source
This commit is contained in:
AlexKnauth 2015-12-13 22:55:39 -05:00
parent 3ebc839959
commit 7ab893af5e
4 changed files with 88 additions and 84 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
lens/private/list/sublist.rkt Normal file
View File

@ -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))
)

65
lens/private/string/substring.rkt Normal file
View File

@ -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!
)

21
unstable/lens/sublist.rkt
View File

@ -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

67
unstable/lens/substring.rkt
View File

@ -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!
)
#lang reprovide
lens/private/string/substring