Contracts #22
This commit is contained in:
Jack Firth 2015-07-08 10:30:49 -07:00
commit 4a05f25f06
12 changed files with 75 additions and 40 deletions

View File

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

View File

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

View File

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

View File

@ -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
lens-transform*)
(provide
(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))))

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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