Merge pull request #87 from jackfirth/contracts-#22

Contracts #22

lens/base/base.rkt

@@ -6,10 +6,13 @@
   (require rackunit))
 
 (provide let-lens
-         make-lens
+         (contract-out [make-lens (-> (-> any/c any/c)
-         focus-lens
+                                      (-> any/c any/c any/c)
-         use-applicable-lenses!
+                                      lens?)]
-         (rename-out [lens-struct? lens?]))
+                       [focus-lens (-> lens? any/c
+                                       (values any/c (-> any/c any/c)))]
+                       [use-applicable-lenses! (-> void?)]
+                       [lens? predicate/c]))
 
 
 (define lenses-applicable? (make-parameter #f))
@@ -28,6 +31,7 @@
   (require rackunit)
   (check-exn exn:fail? (thunk (first-lens '(a b c)))))
 
+(define lens? lens-struct?)
 
 (define (make-lens getter setter)
   (lens-struct getter setter))

lens/base/compose.rkt

@@ -8,8 +8,9 @@
 (module+ test
   (require rackunit))
 
-(provide lens-compose
+(provide
-         lens-thrush)
+ (contract-out [lens-compose (->* () () #:rest (listof lens?) lens?)]
+               [lens-thrush (->* () () #:rest (listof lens?) lens?)]))
 
 
 (define (lens-compose2 sub-lens super-lens)

lens/base/identity.rkt

@@ -6,7 +6,8 @@
   (require rackunit
            "view-set.rkt"))
 
-(provide identity-lens)
+(provide
+ (contract-out [identity-lens lens?]))
 
 
 (define (second-value _ v) v)

lens/base/transform.rkt

@@ -1,16 +1,23 @@
 #lang racket
 
 (require unstable/sequence
-         "base.rkt")
+         "base.rkt"
+         "../list-pair-contract.rkt")
 
 (module+ test
   (require rackunit
            fancy-app))
 
-(provide lens-transform
+(provide
-         lens-transform*)
+ (contract-out
+  [lens-transform (-> lens? any/c (-> any/c any/c) any/c)]
+  [lens-transform* (->* (any/c) #:rest (listof2 lens? (-> any/c any/c)) any/c)]))
 
 
+
+(define (listof* . contracts)
+  (or/c '() (apply list/c (append contracts (list (apply listof* contracts))))))
+                                     
 (define (lens-transform lens v f)
   (let-lens (view setter) lens v
     (setter (f view))))

lens/base/view-set.rkt

@@ -2,14 +2,17 @@
 
 (require unstable/sequence
          fancy-app
-         "base.rkt")
+         "base.rkt"
+         "../list-pair-contract.rkt")
+
 (module+ test
   (require rackunit))
 
-(provide lens-view
+(provide
-         lens-set
+ (contract-out [lens-view (-> lens? any/c any/c)]
-         lens-view*
+               [lens-view* (->* (any/c) #:rest (listof lens?) any/c)]
-         lens-set*)
+               [lens-set (-> lens? any/c any/c any/c)]
+               [lens-set* (->* (any/c) #:rest (listof2 lens? any/c) any/c)]))
 
 
 (define (lens-view lens v)

lens/hash.rkt

@@ -1,6 +1,8 @@
-#lang racket/base
+#lang racket
 
-(provide hash-ref-lens)
+(provide
+ (contract-out
+  [hash-ref-lens (-> any/c lens?)]))
 
 (require fancy-app
          "base/main.rkt")

lens/list-pair-contract.rkt

@@ -0,0 +1,10 @@
+#lang racket
+
+(provide
+ (contract-out [listof2 (-> contract? contract? contract?)]))
+
+
+(define (listof2 first-val/c second-val/c)
+  (define c
+    (or/c empty? (cons/c first-val/c (cons/c second-val/c (recursive-contract c)))))
+  c)

lens/list/assoc.rkt

@@ -1,8 +1,9 @@
-#lang racket/base
+#lang racket
 
-(provide assoc-lens
+(provide
-         assv-lens
+ (contract-out [assoc-lens (->* (any/c) (#:is-equal? (-> any/c any/c boolean?)) lens?)]
-         assq-lens)
+               [assv-lens (-> any/c lens?)]
+               [assq-lens (-> any/c lens?)]))
 
 (require racket/list
          fancy-app

lens/list/cadr-etc.rkt

@@ -17,7 +17,7 @@
 
 (define-simple-macro (provide-c_r-lens id:id)
   #:with c_r-lens (c_r-lens-id #'id)
-  (provide c_r-lens))
+  (provide (contract-out [c_r-lens lens?])))
 
 (provide-c_r-lenses
  aa ad da dd

lens/list/car-cdr.rkt

@@ -1,6 +1,8 @@
-#lang racket/base
+#lang racket
 
-(provide car-lens cdr-lens)
+(provide
+ (contract-out [car-lens lens?]
+               [cdr-lens lens?]))
 
 (require "../base/main.rkt")
 

lens/list/list-ref-take-drop.rkt

@@ -1,19 +1,21 @@
-#lang racket/base
+#lang racket
 
-(provide list-ref-lens
+(provide
-         list-ref-nested-lens
+ (contract-out
-         take-lens
+  [list-ref-lens (-> exact-nonnegative-integer? lens?)]
-         drop-lens
+  [list-ref-nested-lens (->* () #:rest (listof exact-nonnegative-integer?) lens?)]
-         first-lens
+  [take-lens (-> exact-nonnegative-integer? lens?)]
-         second-lens
+  [drop-lens (-> exact-nonnegative-integer? lens?)]
-         third-lens
+  [first-lens lens?]
-         fourth-lens
+  [second-lens lens?]
-         fifth-lens
+  [third-lens lens?]
-         sixth-lens
+  [fourth-lens lens?]
-         seventh-lens
+  [fifth-lens lens?]
-         eighth-lens
+  [sixth-lens lens?]
-         ninth-lens
+  [seventh-lens lens?]
-         tenth-lens)
+  [eighth-lens lens?]
+  [ninth-lens lens?]
+  [tenth-lens lens?]))
 
 (require racket/list
          fancy-app

lens/syntax-keyword.rkt

@@ -7,7 +7,9 @@
 (module+ test
   (require rackunit))
 
-(provide syntax-keyword-seq-lens)
+(provide
+ (contract-out
+  [syntax-keyword-seq-lens (-> keyword? lens?)]))
 
 
 (define-syntax-rule (syntax-parse/default-noop stx option-or-clause ...)