suzanne.soy/lens
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge pull request #175 from jackfirth/158-iso-naming

Browse Source 
Rename isomorphism to make-isomorphism and add more sweet expressions
This commit is contained in:
Jack Firth 2015-08-21 14:51:14 -07:00
commit 8f7295976e
9 changed files with 123 additions and 110 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
lens/compound/compose.rkt
View File

@ -31,8 +31,8 @@ provide
(match args
[(list)
identity-lens]
[(list (isomorphism-lens fs invs) ...)
(isomorphism-lens
[(list (make-isomorphism-lens fs invs) ...)
(make-isomorphism-lens
(apply compose1 fs)
(apply compose1 (reverse invs)))]
[_

2
lens/compound/identity.rkt
View File

@ -15,7 +15,7 @@ provide
(define identity-lens
(isomorphism-lens identity identity))
(make-isomorphism-lens identity identity))
(module+ test
(check-equal? (lens-view identity-lens 'foo) 'foo)

29
lens/compound/join-string.rkt
View File

@ -1,26 +1,27 @@
#lang racket/base
#lang sweet-exp racket/base
(require racket/contract
"../base/main.rkt"
"../util/immutable.rkt"
"compose.rkt"
unstable/lens/isomorphism/base
"join-list.rkt")
require racket/contract
unstable/lens/isomorphism/base
"../base/main.rkt"
"../util/immutable.rkt"
"../util/rest-contract.rkt"
"compose.rkt"
"join-list.rkt"
(module+ test
(require rackunit
"../list/list-ref-take-drop.rkt"))
module+ test
require rackunit
"../list/list-ref-take-drop.rkt"
(provide
(contract-out
[lens-join/string (->* () #:rest (listof lens?) (lens/c any/c immutable-string?))]))
provide
contract-out
lens-join/string (rest-> (lens/c any/c char?) (lens/c any/c immutable-string?))
(define (lens-join/string . lenses)
(lens-compose list->string-lens (apply lens-join/list lenses)))
(define list->string-lens
(isomorphism-lens list->immutable-string string->list))
(make-isomorphism-lens list->immutable-string string->list))
(module+ test
(define string-first-third-fifth-lens

29
lens/compound/join-vector.rkt
View File

@ -1,26 +1,27 @@
#lang racket/base
#lang sweet-exp racket/base
(require racket/contract
"../base/main.rkt"
"../util/immutable.rkt"
"compose.rkt"
unstable/lens/isomorphism/base
"join-list.rkt")
require racket/contract
unstable/lens/isomorphism/base
"../base/main.rkt"
"../util/immutable.rkt"
"../util/rest-contract.rkt"
"compose.rkt"
"join-list.rkt"
(module+ test
(require rackunit
"../list/list-ref-take-drop.rkt"))
module+ test
require rackunit
"../list/list-ref-take-drop.rkt"
(provide
(contract-out
[lens-join/vector (->* () #:rest (listof lens?) (lens/c any/c immutable-vector?))]))
provide
contract-out
lens-join/vector (rest-> lens? (lens/c any/c immutable-vector?))
(define (lens-join/vector . lenses)
(lens-compose list->vector-lens (apply lens-join/list lenses)))
(define list->vector-lens
(isomorphism-lens list->immutable-vector vector->list))
(make-isomorphism-lens list->immutable-vector vector->list))
(module+ test
(define vector-first-third-fifth-lens

13
unstable/lens/isomorphism.rkt
View File

@ -1,3 +1,10 @@
#lang racket/base
(require "isomorphism/base.rkt" "isomorphism/data.rkt")
(provide (all-from-out "isomorphism/base.rkt" "isomorphism/data.rkt"))
#lang sweet-exp racket/base
require
"isomorphism/base.rkt"
"isomorphism/data.rkt"
provide
all-from-out
"isomorphism/base.rkt"
"isomorphism/data.rkt"

14
unstable/lens/isomorphism.scrbl
View File

@ -6,7 +6,7 @@
@defmodule[unstable/lens/isomorphism]
@defproc[(isomorphism-lens [f (a/c . -> . b/c)] [inv (b/c . -> . a/c)]) lens?]{
@defproc[(make-isomorphism-lens [f (a/c . -> . b/c)] [inv (b/c . -> . a/c)]) lens?]{
Creates a lens for an isomorphism. The @racket[f] argument should be a function
with an inverse, and the @racket[inv] argument should be its inverse.
The @racket[f] function converts targets to views, and the @racket[inv] function
@ -15,7 +15,7 @@ converts views to targets.
So for instance a @racket[symbol->string-lens] could be defined with:
@racketblock[
(define symbol->string-lens
(isomorphism-lens symbol->string string->symbol))
(make-isomorphism-lens symbol->string string->symbol))
]
@lenses-unstable-examples[
(lens-view symbol->string-lens 'something)
@ -24,8 +24,8 @@ So for instance a @racket[symbol->string-lens] could be defined with:
@defproc[(isomorphism-lens? [v any/c]) boolean?]{
A predicate that returns true when @racket[v] is a lens constructed with
@racket[isomorphism-lens], @racket[isomorphism-lens-inverse], or
@racket[isomorphism-lenses], and returns false otherwise.
@racket[make-isomorphism-lens], @racket[isomorphism-lens-inverse], or
@racket[make-isomorphism-lenses], and returns false otherwise.
All isomorphism lenses are also lenses according to @racket[lens?].
}
@ -33,17 +33,17 @@ All isomorphism lenses are also lenses according to @racket[lens?].
Returns the inverse of @racket[iso-lens].
}
@defproc[(isomorphism-lenses [f (a/c . -> . b/c)] [inv (b/c . -> . a/c)])
@defproc[(make-isomorphism-lenses [f (a/c . -> . b/c)] [inv (b/c . -> . a/c)])
(values isomorphism-lens? isomorphism-lens?)]{
Returns two values. The first value is the result of
@racket[(isomorphism-lens f inv)], and the second value is the inverse of that
@racket[(make-isomorphism-lens f inv)], and the second value is the inverse of that
lens.
The lenses @racket[symbol->string-lens] and @racket[string->symbol-lens], for
example, are defined like this:
@racketblock[
(define-values [string->symbol-lens symbol->string-lens]
(isomorphism-lenses string->symbol symbol->string))
(make-isomorphism-lenses string->symbol symbol->string))
]}
@deflenses[[string->symbol-lens symbol->string-lens

54
unstable/lens/isomorphism/base.rkt
View File

@ -1,22 +1,13 @@
#lang racket/base
#lang sweet-exp racket/base
(provide isomorphism-lens
isomorphism-lens?
isomorphism-lens-inverse
isomorphism-lenses
)
(module+ data
(provide string->symbol-lens symbol->string-lens
number->string-lens string->number-lens
list->vector-lens vector->list-lens
list->string-lens string->list-lens
))
provide isomorphism-lens?
isomorphism-lens-inverse
rename-out [isomorphism-lens make-isomorphism-lens]
[isomorphism-lenses make-isomorphism-lenses]
require racket/match
lens/base/gen-lens
(require racket/match
lens/base/gen-lens
)
(module+ test
(require rackunit (submod ".." data)))
(struct isomorphism-lens (f inv) #:transparent
#:methods gen:lens
@ -33,32 +24,3 @@
(define (isomorphism-lenses f inv)
(values (isomorphism-lens f inv)
(isomorphism-lens inv f)))
(module+ data
(define-values [string->symbol-lens symbol->string-lens]
(isomorphism-lenses string->symbol symbol->string))
(define-values [number->string-lens string->number-lens]
(isomorphism-lenses number->string string->number))
(define-values [list->vector-lens vector->list-lens]
(isomorphism-lenses list->vector vector->list))
(define-values [list->string-lens string->list-lens]
(isomorphism-lenses list->string string->list))
)
(module+ test
(test-case "string-symbol"
(check-equal? (lens-view string->symbol-lens "a") 'a)
(check-equal? (lens-set string->symbol-lens "a" 'b) "b")
(check-equal? (lens-view symbol->string-lens 'a) "a")
(check-equal? (lens-set symbol->string-lens 'a "b") 'b))
(test-case "number-string"
(check-equal? (lens-view number->string-lens 5) "5")
(check-equal? (lens-set number->string-lens 5 "6") 6)
(check-equal? (lens-view string->number-lens "5") 5)
(check-equal? (lens-set string->number-lens "5" 6) "6"))
(test-case "inverses"
(check-equal? (isomorphism-lens-inverse string->symbol-lens) symbol->string-lens)
(check-equal? (isomorphism-lens-inverse symbol->string-lens) string->symbol-lens)
(check-equal? (isomorphism-lens-inverse number->string-lens) string->number-lens)
(check-equal? (isomorphism-lens-inverse string->number-lens) number->string-lens))
)

47
unstable/lens/isomorphism/data.rkt
View File

@ -1,3 +1,44 @@
#lang racket/base
(require (submod "base.rkt" data))
(provide (all-from-out (submod "base.rkt" data)))
#lang sweet-exp racket/base
provide string->symbol-lens
symbol->string-lens
number->string-lens
string->number-lens
list->vector-lens
vector->list-lens
list->string-lens
string->list-lens
require lens/base/main
"base.rkt"
module+ test
require rackunit
(define-values [string->symbol-lens symbol->string-lens]
(make-isomorphism-lenses string->symbol symbol->string))
(define-values [number->string-lens string->number-lens]
(make-isomorphism-lenses number->string string->number))
(define-values [list->vector-lens vector->list-lens]
(make-isomorphism-lenses list->vector vector->list))
(define-values [list->string-lens string->list-lens]
(make-isomorphism-lenses list->string string->list))
(module+ test
(test-case "string-symbol"
(check-equal? (lens-view string->symbol-lens "a") 'a)
(check-equal? (lens-set string->symbol-lens "a" 'b) "b")
(check-equal? (lens-view symbol->string-lens 'a) "a")
(check-equal? (lens-set symbol->string-lens 'a "b") 'b))
(test-case "number-string"
(check-equal? (lens-view number->string-lens 5) "5")
(check-equal? (lens-set number->string-lens 5 "6") 6)
(check-equal? (lens-view string->number-lens "5") 5)
(check-equal? (lens-set string->number-lens "5" 6) "6"))
(test-case "inverses"
(check-equal? (isomorphism-lens-inverse string->symbol-lens) symbol->string-lens)
(check-equal? (isomorphism-lens-inverse symbol->string-lens) string->symbol-lens)
(check-equal? (isomorphism-lens-inverse number->string-lens) string->number-lens)
(check-equal? (isomorphism-lens-inverse string->number-lens) number->string-lens)))

41
unstable/lens/list.rkt
View File

@ -1,31 +1,32 @@
#lang racket/base
#lang sweet-exp racket/base
(require racket/contract/base)
(provide (contract-out
[reverse-lens
(lens/c list? list?)]
[last-lens
(lens/c list? any/c)]
))
require racket/contract/base
(require lens/base/main
lens/list/main
lens/compound/main
"isomorphism/base.rkt"
)
provide
contract-out
reverse-lens (lens/c list? list?)
last-lens (lens/c list? any/c)
require lens/base/main
lens/list/main
lens/compound/main
"isomorphism/base.rkt"
module+ test
require rackunit fancy-app
(module+ test
(require rackunit fancy-app))
(define reverse-lens
(isomorphism-lens reverse reverse))
(make-isomorphism-lens reverse reverse))
module+ test
(check-equal? (lens-view reverse-lens '(1 2 3)) '(3 2 1))
(check-equal? (lens-transform reverse-lens '(1 2 3) (cons 4 _)) '(1 2 3 4))
(define last-lens
(lens-thrush reverse-lens first-lens))
(module+ test
(check-equal? (lens-view reverse-lens '(1 2 3)) '(3 2 1))
(check-equal? (lens-transform reverse-lens '(1 2 3) (cons 4 _)) '(1 2 3 4))
module+ test
(check-equal? (lens-view last-lens '(1 2 3)) 3)
(check-equal? (lens-set last-lens '(1 2 3) 'a) '(1 2 a))
)