diff --git a/lens/compound/compose.rkt b/lens/compound/compose.rkt index b218c02..3e203ef 100644 --- a/lens/compound/compose.rkt +++ b/lens/compound/compose.rkt @@ -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)))] [_ diff --git a/lens/compound/identity.rkt b/lens/compound/identity.rkt index 937f844..2940ce4 100644 --- a/lens/compound/identity.rkt +++ b/lens/compound/identity.rkt @@ -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) diff --git a/lens/compound/join-string.rkt b/lens/compound/join-string.rkt index fa6b4ab..ad0ee2b 100644 --- a/lens/compound/join-string.rkt +++ b/lens/compound/join-string.rkt @@ -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 diff --git a/lens/compound/join-vector.rkt b/lens/compound/join-vector.rkt index f2eb3d7..aebd569 100644 --- a/lens/compound/join-vector.rkt +++ b/lens/compound/join-vector.rkt @@ -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 diff --git a/unstable/lens/isomorphism.rkt b/unstable/lens/isomorphism.rkt index 6d413a3..aa41a8d 100644 --- a/unstable/lens/isomorphism.rkt +++ b/unstable/lens/isomorphism.rkt @@ -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" diff --git a/unstable/lens/isomorphism.scrbl b/unstable/lens/isomorphism.scrbl index 26c23bf..80705c2 100644 --- a/unstable/lens/isomorphism.scrbl +++ b/unstable/lens/isomorphism.scrbl @@ -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 diff --git a/unstable/lens/isomorphism/base.rkt b/unstable/lens/isomorphism/base.rkt index 165b66c..98eae5d 100644 --- a/unstable/lens/isomorphism/base.rkt +++ b/unstable/lens/isomorphism/base.rkt @@ -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)) - ) diff --git a/unstable/lens/isomorphism/data.rkt b/unstable/lens/isomorphism/data.rkt index e558621..c82f242 100644 --- a/unstable/lens/isomorphism/data.rkt +++ b/unstable/lens/isomorphism/data.rkt @@ -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))) diff --git a/unstable/lens/list.rkt b/unstable/lens/list.rkt index aaece86..1fd9f56 100644 --- a/unstable/lens/list.rkt +++ b/unstable/lens/list.rkt @@ -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)) - )