From 7d76d71dc236eb709c63176609a6c54d207c562d Mon Sep 17 00:00:00 2001 From: Jack Firth Date: Wed, 8 Jul 2015 01:25:32 -0700 Subject: [PATCH 01/14] Add contracts to core --- lens/base/base.rkt | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/lens/base/base.rkt b/lens/base/base.rkt index 13b771a..70b3750 100644 --- a/lens/base/base.rkt +++ b/lens/base/base.rkt @@ -6,10 +6,13 @@ (require rackunit)) (provide let-lens - make-lens - focus-lens - use-applicable-lenses! - (rename-out [lens-struct? lens?])) + (contract-out [make-lens (-> (-> any/c any/c) + (-> any/c any/c any/c) + 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)) From ed16d1ab04d87e160164979230d821506bc7699a Mon Sep 17 00:00:00 2001 From: Jack Firth Date: Wed, 8 Jul 2015 01:26:43 -0700 Subject: [PATCH 02/14] Add contracts to lens composition --- lens/base/compose.rkt | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lens/base/compose.rkt b/lens/base/compose.rkt index da1cd9f..c9cecff 100644 --- a/lens/base/compose.rkt +++ b/lens/base/compose.rkt @@ -8,8 +8,9 @@ (module+ test (require rackunit)) -(provide lens-compose - lens-thrush) +(provide + (contract-out [lens-compose (->* () () #:rest lens? lens?)] + [lens-thrush (->* () () #:rest lens? lens?)])) (define (lens-compose2 sub-lens super-lens) From 5c681189f07ac5e653f0eaf7591fd502f0fbca29 Mon Sep 17 00:00:00 2001 From: Jack Firth Date: Wed, 8 Jul 2015 01:27:10 -0700 Subject: [PATCH 03/14] Add id-lens contract --- lens/base/identity.rkt | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lens/base/identity.rkt b/lens/base/identity.rkt index 4e1f329..2ce5710 100644 --- a/lens/base/identity.rkt +++ b/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) From 6fe10f3ec4673fe1b899eaf912f6004072ddbee5 Mon Sep 17 00:00:00 2001 From: Jack Firth Date: Wed, 8 Jul 2015 01:29:03 -0700 Subject: [PATCH 04/14] Fix compose contract --- lens/base/compose.rkt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lens/base/compose.rkt b/lens/base/compose.rkt index c9cecff..4f43f09 100644 --- a/lens/base/compose.rkt +++ b/lens/base/compose.rkt @@ -9,8 +9,8 @@ (require rackunit)) (provide - (contract-out [lens-compose (->* () () #:rest lens? lens?)] - [lens-thrush (->* () () #:rest lens? lens?)])) + (contract-out [lens-compose (->* () () #:rest (listof lens?) lens?)] + [lens-thrush (->* () () #:rest (listof lens?) lens?)])) (define (lens-compose2 sub-lens super-lens) From 32c580d8490f94996c5d4dc34e690262b6fc393a Mon Sep 17 00:00:00 2001 From: Jack Firth Date: Wed, 8 Jul 2015 01:34:27 -0700 Subject: [PATCH 05/14] Add transform contract --- lens/base/transform.rkt | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/lens/base/transform.rkt b/lens/base/transform.rkt index 0ea3f7e..7909070 100644 --- a/lens/base/transform.rkt +++ b/lens/base/transform.rkt @@ -7,10 +7,15 @@ (require rackunit fancy-app)) -(provide lens-transform - lens-transform*) +(provide + lens-transform* + (contract-out [lens-transform (-> lens? any/c (-> 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)))) From 837606788a47c9c45c43d292a8c9514310dc43ac Mon Sep 17 00:00:00 2001 From: Jack Firth Date: Wed, 8 Jul 2015 01:37:57 -0700 Subject: [PATCH 06/14] Add view/set contracts --- lens/base/view-set.rkt | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/lens/base/view-set.rkt b/lens/base/view-set.rkt index b5a55ff..d919f49 100644 --- a/lens/base/view-set.rkt +++ b/lens/base/view-set.rkt @@ -6,10 +6,11 @@ (module+ test (require rackunit)) -(provide lens-view - lens-set - lens-view* - lens-set*) +(provide + lens-view* + lens-set* + (contract-out [lens-view (-> lens? any/c any/c)] + [lens-set (-> lens? any/c any/c any/c)])) (define (lens-view lens v) From bb8dc5803732c97a2f3d3a73c2f2a2a13955f2e0 Mon Sep 17 00:00:00 2001 From: Jack Firth Date: Wed, 8 Jul 2015 09:59:22 -0700 Subject: [PATCH 07/14] Add assoc contracts --- lens/list/assoc.rkt | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/lens/list/assoc.rkt b/lens/list/assoc.rkt index 63020da..0cd114d 100644 --- a/lens/list/assoc.rkt +++ b/lens/list/assoc.rkt @@ -1,8 +1,9 @@ -#lang racket/base +#lang racket -(provide assoc-lens - assv-lens - assq-lens) +(provide + (contract-out [assoc-lens (->* (any/c) (#:is-equal? (-> any/c any/c boolean?)) lens?)] + [assv-lens (-> any/c lens?)] + [assq-lens (-> any/c lens?)])) (require racket/list fancy-app From db0b7ad6f27a1877a32ec2a396894fecc754aa88 Mon Sep 17 00:00:00 2001 From: Jack Firth Date: Wed, 8 Jul 2015 09:59:30 -0700 Subject: [PATCH 08/14] Add pair shorthand contracts --- lens/list/cadr-etc.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lens/list/cadr-etc.rkt b/lens/list/cadr-etc.rkt index 60cbe37..76b5b3f 100644 --- a/lens/list/cadr-etc.rkt +++ b/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 From 31e52b769713250e2e59c467341eb2bec37596db Mon Sep 17 00:00:00 2001 From: Jack Firth Date: Wed, 8 Jul 2015 10:00:29 -0700 Subject: [PATCH 09/14] Add lens-view* contract --- lens/base/view-set.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lens/base/view-set.rkt b/lens/base/view-set.rkt index d919f49..c58b1e5 100644 --- a/lens/base/view-set.rkt +++ b/lens/base/view-set.rkt @@ -7,9 +7,9 @@ (require rackunit)) (provide - lens-view* lens-set* (contract-out [lens-view (-> lens? any/c any/c)] + [lens-view* (->* [any/c] #:rest (listof lens?) any/c)] [lens-set (-> lens? any/c any/c any/c)])) From 94a13eccaaa5dd13e73992b3b3f0707def8423b1 Mon Sep 17 00:00:00 2001 From: Jack Firth Date: Wed, 8 Jul 2015 10:06:39 -0700 Subject: [PATCH 10/14] Add set* and transform* contracts --- lens/base/transform.rkt | 10 ++++++---- lens/base/view-set.rkt | 10 ++++++---- lens/list-pair-contract.rkt | 10 ++++++++++ 3 files changed, 22 insertions(+), 8 deletions(-) create mode 100644 lens/list-pair-contract.rkt diff --git a/lens/base/transform.rkt b/lens/base/transform.rkt index 7909070..1b4fd34 100644 --- a/lens/base/transform.rkt +++ b/lens/base/transform.rkt @@ -1,16 +1,18 @@ #lang racket (require unstable/sequence - "base.rkt") + "base.rkt" + "../list-pair-contract.rkt") (module+ test (require rackunit fancy-app)) (provide - lens-transform* - (contract-out [lens-transform (-> lens? any/c (-> any/c any/c) any/c)])) - + (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) diff --git a/lens/base/view-set.rkt b/lens/base/view-set.rkt index c58b1e5..c63424b 100644 --- a/lens/base/view-set.rkt +++ b/lens/base/view-set.rkt @@ -2,15 +2,17 @@ (require unstable/sequence fancy-app - "base.rkt") + "base.rkt" + "../list-pair-contract.rkt") + (module+ test (require rackunit)) (provide - lens-set* (contract-out [lens-view (-> lens? any/c any/c)] - [lens-view* (->* [any/c] #:rest (listof lens?) any/c)] - [lens-set (-> lens? any/c any/c any/c)])) + [lens-view* (->* (any/c) #:rest (listof lens?) any/c)] + [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) diff --git a/lens/list-pair-contract.rkt b/lens/list-pair-contract.rkt new file mode 100644 index 0000000..411a3e3 --- /dev/null +++ b/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) From 4e154f1dbb718d45c358c3065b20a4bbbc834534 Mon Sep 17 00:00:00 2001 From: Jack Firth Date: Wed, 8 Jul 2015 10:10:49 -0700 Subject: [PATCH 11/14] Add car/cdr lens contracts --- lens/list/car-cdr.rkt | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lens/list/car-cdr.rkt b/lens/list/car-cdr.rkt index 91d6495..4016316 100644 --- a/lens/list/car-cdr.rkt +++ b/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") From 7cb337f131243621bd3883b28364b9b169b96eb2 Mon Sep 17 00:00:00 2001 From: Jack Firth Date: Wed, 8 Jul 2015 10:13:53 -0700 Subject: [PATCH 12/14] Add list contracts --- lens/list/list-ref-take-drop.rkt | 32 +++++++++++++++++--------------- 1 file changed, 17 insertions(+), 15 deletions(-) diff --git a/lens/list/list-ref-take-drop.rkt b/lens/list/list-ref-take-drop.rkt index 276d4e2..384d5a4 100644 --- a/lens/list/list-ref-take-drop.rkt +++ b/lens/list/list-ref-take-drop.rkt @@ -1,19 +1,21 @@ -#lang racket/base +#lang racket -(provide list-ref-lens - list-ref-nested-lens - take-lens - drop-lens - first-lens - second-lens - third-lens - fourth-lens - fifth-lens - sixth-lens - seventh-lens - eighth-lens - ninth-lens - tenth-lens) +(provide + (contract-out + [list-ref-lens (-> exact-nonnegative-integer? lens?)] + [list-ref-nested-lens (->* () #:rest (listof exact-nonnegative-integer?) lens?)] + [take-lens (-> exact-nonnegative-integer? lens?)] + [drop-lens (-> exact-nonnegative-integer? lens?)] + [first-lens lens?] + [second-lens lens?] + [third-lens lens?] + [fourth-lens lens?] + [fifth-lens lens?] + [sixth-lens lens?] + [seventh-lens lens?] + [eighth-lens lens?] + [ninth-lens lens?] + [tenth-lens lens?])) (require racket/list fancy-app From ba7d20446ae77416a98330924de6b9af73c3ebe2 Mon Sep 17 00:00:00 2001 From: Jack Firth Date: Wed, 8 Jul 2015 10:14:39 -0700 Subject: [PATCH 13/14] Add hash contract --- lens/hash.rkt | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lens/hash.rkt b/lens/hash.rkt index 1e7acae..96173ab 100644 --- a/lens/hash.rkt +++ b/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") From ac803ad8f5823ce0d4b29d7a3850e9d703a2cbd3 Mon Sep 17 00:00:00 2001 From: Jack Firth Date: Wed, 8 Jul 2015 10:15:46 -0700 Subject: [PATCH 14/14] Add syntax keyword contract --- lens/syntax-keyword.rkt | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lens/syntax-keyword.rkt b/lens/syntax-keyword.rkt index 5791f92..09b6888 100644 --- a/lens/syntax-keyword.rkt +++ b/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 ...)