use lens/c contracts to enforce immutability

for dicts, make sure the dict supports functional update

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

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

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

unstable/lens/hash.rkt

@@ -2,11 +2,13 @@
 
 (provide
  (contract-out
-  [hash-ref-lens (-> any/c lens?)]
+  [hash-ref-lens (-> any/c (lens/c immutable-hash? any/c))]
-  [hash-ref-nested-lens (->* () #:rest list? lens?)]))
+  [hash-ref-nested-lens (->* () #:rest list? (lens/c immutable-hash? any/c))]))
 
 (require fancy-app
-         lens)
+         lens
+         lens/util/immutable
+         )
 
 (module+ test
   (require rackunit))

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/list (->* () #:rest (listof lens?) (lens/c any/c list?))]
-  [lens-join/hash (->* () #:rest (listof2 any/c lens?) lens?)]
+  [lens-join/hash (->* () #:rest (listof2 any/c lens?) (lens/c any/c immutable-hash?))]
-  [lens-join/vector (->* () #:rest (listof lens?) lens?)]
+  [lens-join/vector (->* () #:rest (listof lens?) (lens/c any/c immutable-vector?))]
-  [lens-join/string (->* () #:rest (listof lens?) lens?)]
+  [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))
 

unstable/lens/string.rkt

@@ -1,10 +1,18 @@
 #lang racket/base
 
-(provide string-ref-lens
+(require racket/contract/base)
-         string-pick-lens)
+(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-immutable-string
-   (build-string (string-length s)
+   (string-length s)
    (λ (j)
      (if (= i j)
          c
-                       (string-ref s j))))))
+         (string-ref s j)))))
 
 (module+ test
   (check-equal? (lens-view (string-ref-lens 2) "abc") #\c)

unstable/lens/vector.rkt

@@ -1,11 +1,21 @@
 #lang racket/base
 
-(provide vector-ref-lens
+(require racket/contract/base)
-         vector-ref-nested-lens
+(provide (contract-out
-         vector-pick-lens)
+          [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-immutable-vector
-   (build-vector (vector-length v)
+   (vector-length v)
    (λ (j)
      (if (= i j)
          x
-                       (vector-ref v j))))))
+         (vector-ref v j)))))
 
 (module+ test
   (check-equal? (lens-view (vector-ref-lens 0) #(a b c)) 'a)