add isomorphism-compose and isomorphism-thrush
also take away special case in lens-compose for isomorphisms
This commit is contained in:
parent
fdade525f4
commit
ec08ef67dd
|
@ -7,7 +7,6 @@ require racket/contract
|
||||||
"../base/main.rkt"
|
"../base/main.rkt"
|
||||||
"../util/rest-contract.rkt"
|
"../util/rest-contract.rkt"
|
||||||
"identity.rkt"
|
"identity.rkt"
|
||||||
unstable/lens/isomorphism/base
|
|
||||||
|
|
||||||
module+ test
|
module+ test
|
||||||
require rackunit
|
require rackunit
|
||||||
|
@ -29,15 +28,7 @@ provide
|
||||||
|
|
||||||
|
|
||||||
(define (lens-compose . args)
|
(define (lens-compose . args)
|
||||||
(match args
|
(foldr lens-compose2 identity-lens args))
|
||||||
[(list)
|
|
||||||
identity-lens]
|
|
||||||
[(list (make-isomorphism-lens fs invs) ...)
|
|
||||||
(make-isomorphism-lens
|
|
||||||
(apply compose1 fs)
|
|
||||||
(apply compose1 (reverse invs)))]
|
|
||||||
[_
|
|
||||||
(foldr lens-compose2 identity-lens args)]))
|
|
||||||
|
|
||||||
|
|
||||||
module+ test
|
module+ test
|
||||||
|
@ -52,5 +43,3 @@ module+ test
|
||||||
(check-equal? (lens-view first-of-second-lens test-alist) 'b)
|
(check-equal? (lens-view first-of-second-lens test-alist) 'b)
|
||||||
(check-equal? (lens-set first-of-second-lens test-alist 'B) '((a 1) (B 2) (c 3)))
|
(check-equal? (lens-set first-of-second-lens test-alist 'B) '((a 1) (B 2) (c 3)))
|
||||||
(check-eq? (lens-compose) identity-lens)
|
(check-eq? (lens-compose) identity-lens)
|
||||||
(check-pred isomorphism-lens? (lens-compose (make-isomorphism-lens set->list list->set)
|
|
||||||
(make-isomorphism-lens list->vector vector->list)))
|
|
||||||
|
|
|
@ -1,3 +1,4 @@
|
||||||
#lang reprovide
|
#lang reprovide
|
||||||
"isomorphism/base.rkt"
|
"isomorphism/base.rkt"
|
||||||
|
"isomorphism/compound.rkt"
|
||||||
"isomorphism/data.rkt"
|
"isomorphism/data.rkt"
|
||||||
|
|
|
@ -46,6 +46,16 @@ example, are defined like this:
|
||||||
(make-isomorphism-lenses string->symbol symbol->string))
|
(make-isomorphism-lenses string->symbol symbol->string))
|
||||||
]}
|
]}
|
||||||
|
|
||||||
|
@defproc[(isomorphism-compose [lens isomorphism-lens?] ...) isomorphism-lens?]{
|
||||||
|
Like @racket[lens-compose], but works only on isomorphism lenses, and returns an
|
||||||
|
isomorphism lens.
|
||||||
|
}
|
||||||
|
|
||||||
|
@defproc[(isomorphism-thrush [lens isomorphism-lens?] ...) isomorphism-lens?]{
|
||||||
|
Like @racket[lens-thrush], but works only on isomorphism lenses, and returns an
|
||||||
|
isomorphism lens.
|
||||||
|
}
|
||||||
|
|
||||||
@deflenses[[string->symbol-lens symbol->string-lens
|
@deflenses[[string->symbol-lens symbol->string-lens
|
||||||
number->string-lens string->number-lens
|
number->string-lens string->number-lens
|
||||||
list->vector-lens vector->list-lens
|
list->vector-lens vector->list-lens
|
||||||
|
|
18
unstable/lens/isomorphism/compound.rkt
Normal file
18
unstable/lens/isomorphism/compound.rkt
Normal file
|
@ -0,0 +1,18 @@
|
||||||
|
#lang sweet-exp racket/base
|
||||||
|
|
||||||
|
provide isomorphism-compose
|
||||||
|
isomorphism-thrush
|
||||||
|
|
||||||
|
require racket/match
|
||||||
|
"base.rkt"
|
||||||
|
|
||||||
|
(define (isomorphism-compose . args)
|
||||||
|
(match args
|
||||||
|
[(list (make-isomorphism-lens fs invs) ...)
|
||||||
|
(make-isomorphism-lens
|
||||||
|
(apply compose1 fs)
|
||||||
|
(apply compose1 (reverse invs)))]))
|
||||||
|
|
||||||
|
(define (isomorphism-thrush . args)
|
||||||
|
(apply isomorphism-compose (reverse args)))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user