commit
4a05f25f06
|
@ -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))
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -6,7 +6,8 @@
|
|||
(require rackunit
|
||||
"view-set.rkt"))
|
||||
|
||||
(provide identity-lens)
|
||||
(provide
|
||||
(contract-out [identity-lens lens?]))
|
||||
|
||||
|
||||
(define (second-value _ v) v)
|
||||
|
|
|
@ -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))))
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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")
|
||||
|
|
10
lens/list-pair-contract.rkt
Normal file
10
lens/list-pair-contract.rkt
Normal 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)
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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")
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ...)
|
||||
|
|
Loading…
Reference in New Issue
Block a user