diff --git a/lens/dict.rkt b/lens/dict.rkt index 33780bb..fbf15c7 100644 --- a/lens/dict.rkt +++ b/lens/dict.rkt @@ -1,6 +1,10 @@ #lang racket/base -(provide dict-ref-lens) +(require racket/contract/base) +(provide (contract-out + [dict-ref-lens + (-> any/c (lens/c functional-dict? any/c))] + )) (require racket/dict fancy-app "base/main.rkt") (module+ test @@ -10,6 +14,9 @@ (make-lens (dict-ref _ key) (dict-set _ key _))) +(define (functional-dict? v) + (and (dict? v) (dict-can-functional-set? v))) + (module+ test (check-equal? (lens-transform/list '((a . 1) (b . 2) (c . 3)) (dict-ref-lens 'a) (* 100 _)) '((a . 100) (b . 2) (c . 3)))) diff --git a/lens/util/immutable.rkt b/lens/util/immutable.rkt new file mode 100644 index 0000000..9f82d91 --- /dev/null +++ b/lens/util/immutable.rkt @@ -0,0 +1,33 @@ +#lang racket/base + +(provide (all-defined-out)) + +;; The immutable? predicate only works for strings, byte-strings, vectors, hash-tables, and boxes. + +(define (immutable-string? v) + (and (string? v) (immutable? v))) + +(define (immutable-bytes? v) + (and (bytes? v) (immutable? v))) + +(define (immutable-vector? v) + (and (vector? v) (immutable? v))) + +(define (immutable-hash? v) + (and (hash? v) (immutable? v))) + +(define (immutable-box? v) + (and (box? v) (immutable? v))) + +(define (list->immutable-string lst) + (string->immutable-string (list->string lst))) + +(define (list->immutable-vector lst) + (apply vector-immutable lst)) + +(define (build-immutable-string n f) + (string->immutable-string (build-string n f))) + +(define (build-immutable-vector n f) + (vector->immutable-vector (build-vector n f))) + diff --git a/unstable/lens/hash-pick.rkt b/unstable/lens/hash-pick.rkt index 1c96a87..f0d4e4f 100644 --- a/unstable/lens/hash-pick.rkt +++ b/unstable/lens/hash-pick.rkt @@ -1,9 +1,14 @@ #lang racket/base -(provide hash-pick-lens) +(require racket/contract/base) +(provide (contract-out + [hash-pick-lens + (->* [] #:rest list? (lens/c immutable-hash? immutable-hash?))] + )) (require racket/list lens/base/main + lens/util/immutable "hash.rkt" "join.rkt") diff --git a/unstable/lens/hash.rkt b/unstable/lens/hash.rkt index a830e5f..5a20f17 100644 --- a/unstable/lens/hash.rkt +++ b/unstable/lens/hash.rkt @@ -2,11 +2,13 @@ (provide (contract-out - [hash-ref-lens (-> any/c lens?)] - [hash-ref-nested-lens (->* () #:rest list? lens?)])) + [hash-ref-lens (-> any/c (lens/c immutable-hash? any/c))] + [hash-ref-nested-lens (->* () #:rest list? (lens/c immutable-hash? any/c))])) (require fancy-app - lens) + lens + lens/util/immutable + ) (module+ test (require rackunit)) diff --git a/unstable/lens/join.rkt b/unstable/lens/join.rkt index d8d1bb8..5175c16 100644 --- a/unstable/lens/join.rkt +++ b/unstable/lens/join.rkt @@ -3,6 +3,7 @@ (require fancy-app lens lens/util/list-pair-contract + lens/util/immutable unstable/sequence) (module+ test @@ -10,10 +11,10 @@ (provide (contract-out - [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?)] + [lens-join/list (->* () #:rest (listof lens?) (lens/c any/c list?))] + [lens-join/hash (->* () #:rest (listof2 any/c lens?) (lens/c any/c immutable-hash?))] + [lens-join/vector (->* () #:rest (listof lens?) (lens/c any/c immutable-vector?))] + [lens-join/string (->* () #:rest (listof lens?) (lens/c any/c immutable-string?))] )) @@ -84,9 +85,6 @@ (λ (tgt) (f tgt)) (λ (tgt v) (f-inv v)))) -(define (list->immutable-vector lst) - (apply vector-immutable lst)) - (define list->vector-lens (inverse-function-lens list->immutable-vector vector->list)) @@ -104,9 +102,6 @@ (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)) diff --git a/unstable/lens/string.rkt b/unstable/lens/string.rkt index 14fe9f5..54f5cc3 100644 --- a/unstable/lens/string.rkt +++ b/unstable/lens/string.rkt @@ -1,10 +1,18 @@ #lang racket/base -(provide string-ref-lens - string-pick-lens) +(require racket/contract/base) +(provide (contract-out + [string-ref-lens + (-> exact-nonnegative-integer? + (lens/c immutable-string? char?))] + [string-pick-lens + (->* [] #:rest (listof exact-nonnegative-integer?) + (lens/c immutable-string? immutable-string?))] + )) (require fancy-app lens/base/main + lens/util/immutable "join.rkt") (module+ test @@ -17,12 +25,12 @@ (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)))))) + (build-immutable-string + (string-length s) + (λ (j) + (if (= i j) + c + (string-ref s j))))) (module+ test (check-equal? (lens-view (string-ref-lens 2) "abc") #\c) diff --git a/unstable/lens/vector.rkt b/unstable/lens/vector.rkt index eb88629..665eba6 100644 --- a/unstable/lens/vector.rkt +++ b/unstable/lens/vector.rkt @@ -1,11 +1,21 @@ #lang racket/base -(provide vector-ref-lens - vector-ref-nested-lens - vector-pick-lens) +(require racket/contract/base) +(provide (contract-out + [vector-ref-lens + (-> exact-nonnegative-integer? + (lens/c immutable-vector? any/c))] + [vector-ref-nested-lens + (->* [] #:rest (listof exact-nonnegative-integer?) + (lens/c immutable-vector? any/c))] + [vector-pick-lens + (->* [] #:rest (listof exact-nonnegative-integer?) + (lens/c immutable-vector? immutable-vector?))] + )) (require fancy-app lens/base/main + lens/util/immutable "arrow.rkt" "join.rkt") @@ -19,12 +29,12 @@ (vector-set _ i _))) (define (vector-set v i x) - (vector->immutable-vector - (build-vector (vector-length v) - (λ (j) - (if (= i j) - x - (vector-ref v j)))))) + (build-immutable-vector + (vector-length v) + (λ (j) + (if (= i j) + x + (vector-ref v j))))) (module+ test (check-equal? (lens-view (vector-ref-lens 0) #(a b c)) 'a)