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

Merge pull request #150 from jackfirth/121-2.0-feature-set

Browse Source 
121 2.0 feature set
This commit is contained in:
Jack Firth 2015-08-19 10:02:15 -07:00
commit beaaa03642
71 changed files with 792 additions and 561 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
info.rkt
View File

@ -24,21 +24,45 @@
(define test-omit-paths
'("info.rkt"
"lens/info.rkt"
"lens/applicable.scrbl"
"lens/deflenses.rkt"
"lens/lenses-examples.rkt"
"lens/main.scrbl"
"lens/syntax.scrbl"
"lens/base/base.scrbl"
"lens/base/compose.scrbl"
"lens/base/contract.scrbl"
"lens/base/laws.scrbl"
"lens/base/main.scrbl"
"lens/base/transform.scrbl"
"lens/base/view-set.scrbl"
"lens/compound/compose.scrbl"
"lens/compound/join-hash.scrbl"
"lens/compound/join-list.scrbl"
"lens/compound/join-string.scrbl"
"lens/compound/join-vector.scrbl"
"lens/compound/main.scrbl"
"lens/compound/thrush.scrbl"
"lens/doc-util"
"lens/hash/main.scrbl"
"lens/hash/nested.scrbl"
"lens/hash/pick.scrbl"
"lens/hash/ref.scrbl"
"lens/list/assoc.scrbl"
"lens/list/car-cdr.scrbl"
"lens/list/list-ref-take-drop.scrbl"
"lens/list/main.scrbl"
"lens/list/multi.scrbl"
"lens/struct/field.scrbl"
"lens/struct/main.scrbl"
"lens/struct/struct.scrbl"
"lens/test-util"
"lens/vector/main.scrbl"
"lens/vector/nested.scrbl"
"lens/vector/pick.scrbl"
"lens/vector/ref.scrbl"
"lens/applicable.scrbl"
"lens/dict.scrbl"
"lens/info.rkt"
"lens/main.scrbl"
"lens/stream.scrbl"
"lens/string.scrbl"
"unstable/lens/arrow.scrbl"
"unstable/lens/main.scrbl"
"unstable/lens/compound.scrbl"
"unstable/lens/syntax.scrbl"))
"unstable/lens/sublist.scrbl"
"unstable/lens/syntax.scrbl"
"unstable/lens/view-set.scrbl"))

6
lens/base/main.rkt
View File

@ -3,13 +3,11 @@
(require "base.rkt"
"view-set.rkt"
"transform.rkt"
"identity.rkt"
"compose.rkt")
"identity.rkt")
(provide
(all-from-out
"base.rkt"
"view-set.rkt"
"transform.rkt"
"identity.rkt"
"compose.rkt"))
"identity.rkt"))

1
lens/base/main.scrbl
View File

@ -7,4 +7,3 @@
@include-section["laws.scrbl"]
@include-section["transform.scrbl"]
@include-section["contract.scrbl"]
@include-section["compose.scrbl"]

30
lens/base/compose.rkt → lens/compound/compose.rkt
View File

@ -1,16 +1,15 @@
#lang racket
#lang racket/base
(require fancy-app
"base.rkt"
"view-set.rkt"
"identity.rkt")
(require racket/contract
racket/list
fancy-app
"../base/main.rkt")
(module+ test
(require rackunit))
(provide
(contract-out [lens-compose (->* () () #:rest (listof lens?) lens?)]
[lens-thrush (->* () () #:rest (listof lens?) lens?)]))
(contract-out [lens-compose (->* () () #:rest (listof lens?) lens?)]))
(define (lens-compose2 sub-lens super-lens)
@ -34,18 +33,7 @@
(define (set-second l v)
(list* (first l) v (rest (rest l))))
(define second-lens (make-lens second set-second))
(define first-of-second-lens (lens-compose first-lens second-lens))
(define test-alist '((a 1) (b 2) (c 3)))
(check-eq? (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))))
(define (lens-thrush . args)
(apply lens-compose (reverse args)))
(module+ test
(define first-of-second-lens* (lens-thrush second-lens first-lens))
(let-lens [val ctxt] first-of-second-lens* test-alist
(check-equal? val 'b)
(check-equal? (ctxt 'B) '((a 1) (B 2) (c 3)))))
(define first-of-second-lens (lens-compose first-lens second-lens))
(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))))

12
lens/base/compose.scrbl → lens/compound/compose.scrbl
View File

@ -3,8 +3,6 @@
@(require "../doc-util/main.rkt")
@title{Composing Lenses}
@defproc[(lens-compose [lens lens?] ...) lens?]{
Composes the given lenses together into one @italic{compound lens}.
The compound lens operates similarly to composed functions do in
@ -18,16 +16,6 @@
(lens-set first-of-second-lens '((1 a) (2 b) (3 c)) 200)
]}
@defproc[(lens-thrush [lens lens?] ...) lens?]{
Like @racket[lens-compose], but each @racket[lens] is combined in the
opposite order. That is, the first @racket[lens] is the first
@racket[lens] that the compound lens’s target is viewed through.
@lenses-examples[
(define first-of-second-lens (lens-thrush second-lens first-lens))
(lens-view first-of-second-lens '((1 a) (2 b) (3 c)))
(lens-set first-of-second-lens '((1 a) (2 b) (3 c)) 200)
]}
@defthing[identity-lens lens?]{
The identity lens. Performs no destructuring at all - it's view is
the target itself. For all lenses, both

11
lens/compound/inverse-function-lens.rkt Normal file
View File

@ -0,0 +1,11 @@
#lang racket/base
(require "../base/main.rkt")
(provide inverse-function-lens)
(define (inverse-function-lens f f-inv)
(make-lens
(λ (tgt) (f tgt))
(λ (tgt v) (f-inv v))))

53
lens/compound/join-hash.rkt Normal file
View File

@ -0,0 +1,53 @@
#lang racket/base
(require racket/contract
racket/match
unstable/sequence
fancy-app
"../base/main.rkt"
"../util/immutable.rkt"
"../util/list-pair-contract.rkt"
"join-list.rkt")
(module+ test
(require rackunit
"../list/list-ref-take-drop.rkt"))
(provide
(contract-out
[lens-join/hash (->* () #:rest (listof2 any/c lens?) (lens/c any/c immutable-hash?))]))
(define (value-list->hash keys vs)
(make-immutable-hash (map cons keys vs)))
(define (split-slice n vs)
(define grouped
(for/list ([group (in-slice n vs)])
group))
(define (get-ith i)
(map (list-ref _ i) grouped))
(build-list n get-ith))
(module+ test
(check-equal? (split-slice 3 '(a 1 FOO b 2 BAR c 3 BAZ))
'((a b c) (1 2 3) (FOO BAR BAZ))))
(define (lens-join/hash . keys/lenses)
(match-define (list keys lenses) (split-slice 2 keys/lenses))
(define list-lens (apply lens-join/list lenses))
(define (get target)
(value-list->hash keys (lens-view list-lens target)))
(define (set target new-view-hash)
(lens-set list-lens target (map (hash-ref new-view-hash _) keys)))
(make-lens get set))
(module+ test
(define a-b-lens (lens-join/hash 'b third-lens
'a first-lens))
(check-equal? (lens-view a-b-lens '(1 2 3))
(hash 'a 1 'b 3))
(check-equal? (lens-set a-b-lens '(1 2 3) (hash 'a 100 'b 200))
'(100 2 200)))

17
lens/compound/join-hash.scrbl Normal file
View File

@ -0,0 +1,17 @@
#lang scribble/manual
@(require "../doc-util/main.rkt")
@defproc[(lens-join/hash [key any/c] [lens lens?] ... ...) lens?]{
Constructs a lens that combines the view of each
@racket[lens] into a hash of views with @racket[key]s
as the hash keys. In the same manner as @racket[lens-join/list],
if lenses share views later lenses take precedence when
setting.
@lenses-examples[
(define a-b-lens (lens-join/hash 'a first-lens
'b third-lens))
(lens-view a-b-lens '(1 2 3))
(lens-set a-b-lens '(1 2 3) (hash 'a 100 'b 200))
]}

35
lens/compound/join-list.rkt Normal file
View File

@ -0,0 +1,35 @@
#lang racket/base
(require racket/list
racket/contract
"../base/main.rkt")
(module+ test
(require rackunit
"../list/list-ref-take-drop.rkt"))
(provide
(contract-out
[lens-join/list (->* () #:rest (listof lens?) (lens/c any/c list?))]))
(define (zip xs ys)
(append-map list xs ys))
(define (lens-join/list . lenses)
(define (get target)
(apply lens-view/list target lenses))
(define (set target new-views)
(apply lens-set/list target (zip lenses new-views)))
(make-lens get set))
(module+ test
(define first-third-fifth-lens
(lens-join/list first-lens
third-lens
fifth-lens))
(check-equal? (lens-view first-third-fifth-lens '(a b c d e f))
'(a c e))
(check-equal? (lens-set first-third-fifth-lens '(a b c d e f) '(1 2 3))
'(1 b 2 d 3 f)))

18
lens/compound/join-list.scrbl Normal file
View File

@ -0,0 +1,18 @@
#lang scribble/manual
@(require "../doc-util/main.rkt")
@defproc[(lens-join/list [lens lens?] ...) lens?]{
Constructs a lens that combines the view of each
@racket[lens] into a list of views. This lens can
be used to view and set a list of values in a single
target. If any of the lenses share views, then when
setting the later lenses override the earlier ones.
@lenses-examples[
(define first-third-fifth-lens
(lens-join/list first-lens
third-lens
fifth-lens))
(lens-view first-third-fifth-lens '(a b c d e f))
(lens-set first-third-fifth-lens '(a b c d e f) '(1 2 3))
]}

34
lens/compound/join-string.rkt Normal file
View File

@ -0,0 +1,34 @@
#lang racket/base
(require racket/contract
"../base/main.rkt"
"../util/immutable.rkt"
"compose.rkt"
"inverse-function-lens.rkt"
"join-list.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?))]))
(define (lens-join/string . lenses)
(lens-compose list->string-lens (apply lens-join/list lenses)))
(define list->string-lens
(inverse-function-lens list->immutable-string string->list))
(module+ test
(define string-first-third-fifth-lens
(lens-join/string first-lens
third-lens
fifth-lens))
(check-equal? (lens-view string-first-third-fifth-lens '(#\a #\b #\c #\d #\e #\f))
"ace")
(check-pred immutable? (lens-view string-first-third-fifth-lens '(#\a #\b #\c #\d #\e #\f)))
(check-equal? (lens-set string-first-third-fifth-lens '(#\a #\b #\c #\d #\e #\f) "ACE")
'(#\A #\b #\C #\d #\E #\f)))

16
lens/compound/join-string.scrbl Normal file
View File

@ -0,0 +1,16 @@
#lang scribble/manual
@(require "../doc-util/main.rkt")
@defproc[(lens-join/string [lens lens?] ...) lens?]{
Like @racket[lens-join/list], except the view is a string, not a list.
Each @racket[lens] argument must return a @racket[char?] as a view.
@lenses-examples[
(define string-first-third-fifth-lens
(lens-join/string first-lens
third-lens
fifth-lens))
(lens-view string-first-third-fifth-lens '(#\a #\b #\c #\d #\e #\f))
(lens-set string-first-third-fifth-lens '(#\a #\b #\c #\d #\e #\f) "ACE")
]}

35
lens/compound/join-vector.rkt Normal file
View File

@ -0,0 +1,35 @@
#lang racket/base
(require racket/contract
"../base/main.rkt"
"../util/immutable.rkt"
"compose.rkt"
"inverse-function-lens.rkt"
"join-list.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?))]))
(define (lens-join/vector . lenses)
(lens-compose list->vector-lens (apply lens-join/list lenses)))
(define list->vector-lens
(inverse-function-lens list->immutable-vector vector->list))
(module+ test
(define vector-first-third-fifth-lens
(lens-join/vector first-lens
third-lens
fifth-lens))
(check-equal? (lens-view vector-first-third-fifth-lens '(a b c d e f))
#(a c e))
(check-pred immutable? (lens-view vector-first-third-fifth-lens '(a b c d e f)))
(check-equal? (lens-set vector-first-third-fifth-lens '(a b c d e f) #(1 2 3))
'(1 b 2 d 3 f)))

15
lens/compound/join-vector.scrbl Normal file
View File

@ -0,0 +1,15 @@
#lang scribble/manual
@(require "../doc-util/main.rkt")
@defproc[(lens-join/vector [lens lens?] ...) lens?]{
Like @racket[lens-join/list], except the view is a vector, not a list.
@lenses-examples[
(define vector-first-third-fifth-lens
(lens-join/vector first-lens
third-lens
fifth-lens))
(lens-view vector-first-third-fifth-lens '(a b c d e f))
(lens-set vector-first-third-fifth-lens '(a b c d e f) #(1 2 3))
]}

16
lens/compound/main.rkt Normal file
View File

@ -0,0 +1,16 @@
#lang racket/base
(require "compose.rkt"
"join-hash.rkt"
"join-list.rkt"
"join-string.rkt"
"join-vector.rkt"
"thrush.rkt")
(provide (all-from-out
"compose.rkt"
"join-hash.rkt"
"join-list.rkt"
"join-string.rkt"
"join-vector.rkt"
"thrush.rkt"))

11
lens/compound/main.scrbl Normal file
View File

@ -0,0 +1,11 @@
#lang scribble/manual
@title{Joining and Composing Lenses}
@include-section["compose.scrbl"]
@include-section["thrush.scrbl"]
@include-section["join-list.scrbl"]
@include-section["join-hash.scrbl"]
@include-section["join-vector.scrbl"]
@include-section["join-string.scrbl"]

30
lens/compound/thrush.rkt Normal file
View File

@ -0,0 +1,30 @@
#lang racket/base
(require racket/contract
racket/list
fancy-app
"../base/main.rkt"
"compose.rkt")
(module+ test
(require rackunit
"../list/list-ref-take-drop.rkt"))
(provide
(contract-out [lens-thrush (->* () () #:rest (listof lens?) lens?)]))
(define (lens-thrush . args)
(apply lens-compose (reverse args)))
(module+ test
(define (set-first l v)
(list* v (rest l)))
(define first-lens (make-lens first set-first))
(define (set-second l v)
(list* (first l) v (rest (rest l))))
(define second-lens (make-lens second set-second))
(define test-alist '((a 1) (b 2) (c 3)))
(define first-of-second-lens (lens-thrush second-lens first-lens))
(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))))

14
lens/compound/thrush.scrbl Normal file
View File

@ -0,0 +1,14 @@
#lang scribble/manual
@(require "../doc-util/main.rkt")
@defproc[(lens-thrush [lens lens?] ...) lens?]{
Like @racket[lens-compose], but each @racket[lens] is combined in the
opposite order. That is, the first @racket[lens] is the first
@racket[lens] that the compound lens’s target is viewed through.
@lenses-examples[
(define first-of-second-lens (lens-thrush second-lens first-lens))
(lens-view first-of-second-lens '((1 a) (2 b) (3 c)))
(lens-set first-of-second-lens '((1 a) (2 b) (3 c)) 200)
]}

15
lens/doc-util/main.rkt
View File

@ -8,28 +8,23 @@
racket/base
racket/list
racket/stream
racket/contract
)
racket/contract)
(for-syntax racket/base
syntax/parse
racket/syntax
))
racket/syntax))
(provide (all-from-out
syntax/parse/define
"deflenses.rkt"
"lenses-examples.rkt"
)
"lenses-examples.rkt")
(for-label (all-from-out
lens
unstable/lens
racket/base
racket/list
racket/stream
racket/contract
))
racket/contract))
(for-syntax (all-from-out
racket/base
syntax/parse
racket/syntax
)))
racket/syntax)))

12
lens/hash/main.rkt Normal file
View File

@ -0,0 +1,12 @@
#lang racket/base
(require "nested.rkt"
"pick.rkt"
"ref.rkt")
(provide
(all-from-out "nested.rkt"
"pick.rkt"
"ref.rkt"))

7
lens/hash/main.scrbl Normal file
View File

@ -0,0 +1,7 @@
#lang scribble/manual
@title{Hash Lenses}
@include-section["ref.scrbl"]
@include-section["nested.scrbl"]
@include-section["pick.scrbl"]

27
lens/hash/nested.rkt Normal file
View File

@ -0,0 +1,27 @@
#lang racket
(require "../base/main.rkt"
"../compound/main.rkt"
"../util/immutable.rkt"
"../util/rest-contract.rkt"
"ref.rkt")
(module+ test
(require rackunit
fancy-app))
(provide
(contract-out
[hash-ref-nested-lens (rest-> any/c (lens/c immutable-hash? any/c))]))
(define (hash-ref-nested-lens . keys)
(apply lens-thrush (map hash-ref-lens keys)))
(module+ test
(define a-x (hash-ref-nested-lens 'a 'x))
(let-lens [val ctxt] a-x (hash 'a (hash 'x 1 'y 2) 'b (hash 'z 3))
(check-equal? val 1)
(check-equal? (ctxt 100) (hash 'a (hash 'x 100 'y 2) 'b (hash 'z 3))))
(check-equal? (lens-transform/list (hash 'a (hash 'x 1 'y 2) 'b (hash 'z 3)) a-x (* 10 _))
(hash 'a (hash 'x 10 'y 2) 'b (hash 'z 3))))

14
lens/hash/nested.scrbl Normal file
View File

@ -0,0 +1,14 @@
#lang scribble/manual
@(require "../doc-util/main.rkt")
@defproc[(hash-ref-nested-lens [key any/c] ...) lens?]{
Contructs a lens that targets hashes with nested hashes
as values and views the value obtained by using each
@racket[key] in order.
@lenses-examples[
(define foo-bar-lens (hash-ref-nested-lens 'foo 'bar))
(lens-view foo-bar-lens (hash 'foo (hash 'bar 1)))
(lens-set foo-bar-lens (hash 'foo (hash 'bar 1)) 1000)
]}

30
lens/hash/pick.rkt Normal file
View File

@ -0,0 +1,30 @@
#lang racket/base
(require racket/contract
racket/list
"../base/main.rkt"
"../compound/join-hash.rkt"
"../util/immutable.rkt"
"../util/rest-contract.rkt"
"ref.rkt")
(module+ test
(require rackunit))
(provide
(contract-out
[hash-pick-lens (rest-> any/c (lens/c immutable-hash? immutable-hash?))]))
(define (hash-ref-lens-and-key k)
(list k (hash-ref-lens k)))
(define (hash-pick-lens . ks)
(apply lens-join/hash
(append-map hash-ref-lens-and-key ks)))
(module+ test
(check-equal? (lens-view (hash-pick-lens 'a 'c) (hash 'a 1 'b 2 'c 3))
(hash 'a 1 'c 3))
(check-equal? (lens-set (hash-pick-lens 'a 'c) (hash 'a 1 'b 2 'c 3) (hash 'a 4 'c 5))
(hash 'a 4 'b 2 'c 5)))

13
lens/hash/pick.scrbl Normal file
View File

@ -0,0 +1,13 @@
#lang scribble/manual
@(require "../doc-util/main.rkt")
@defproc[(hash-pick-lens [key any/c] ...) lens?]{
Creates a lens that views a subset of the target hash-table with the given
@racket[key]s. The view, is another hash-table with only the given keys and
their corrosponding values in the target hash-table.
@lenses-examples[
(lens-view (hash-pick-lens 'a 'c) (hash 'a 1 'b 2 'c 3))
(lens-set (hash-pick-lens 'a 'c) (hash 'a 1 'b 2 'c 3) (hash 'a 4 'c 5))
]}

26
lens/hash/ref.rkt Normal file
View File

@ -0,0 +1,26 @@
#lang racket/base
(require racket/contract
fancy-app
"../base/main.rkt"
"../util/immutable.rkt")
(module+ test
(require rackunit))
(provide
(contract-out
[hash-ref-lens (-> any/c (lens/c immutable-hash? any/c))]))
(define (hash-ref-lens key)
(make-lens (hash-ref _ key)
(hash-set _ key _)))
(module+ test
(define a (hash-ref-lens 'a))
(let-lens [val ctxt] a (hash 'a 1 'b 2 'c 3)
(check-equal? val 1)
(check-equal? (ctxt 100) (hash 'a 100 'b 2 'c 3)))
(check-equal? (lens-transform/list (hash 'a 1 'b 2 'c 3) a (* 10 _))
(hash 'a 10 'b 2 'c 3)))

13
lens/hash/ref.scrbl Normal file
View File

@ -0,0 +1,13 @@
#lang scribble/manual
@(require "../doc-util/main.rkt")
@defproc[(hash-ref-lens [key any/c]) lens?]{
Constructs a lens that targets hashes and views the value
of @racket[key].
@lenses-examples[
(define foo-lens (hash-ref-lens 'foo))
(lens-view foo-lens (hash 'foo 10 'bar 20))
(lens-set foo-lens (hash 'foo 10 'bar 20) 1000)
]}

2
lens/info.rkt
View File

@ -1,4 +1,4 @@
#lang info
(define name "lens")
(define scribblings '(("main.scrbl" () (library) "lens")))
(define scribblings '(("main.scrbl" (multi-page) (library) "lens")))

9
lens/list/cadr-etc.rkt
View File

@ -1,9 +1,12 @@
#lang racket
#lang racket/base
(require syntax/parse/define
(require racket/contract
syntax/parse/define
"../base/main.rkt"
"../compound/main.rkt"
"car-cdr.rkt"
(for-syntax racket/syntax))
(for-syntax racket/base
racket/syntax))
(module+ test
(require rackunit))

1
lens/list/list-ref-take-drop.rkt
View File

@ -26,6 +26,7 @@
fancy-app
"../util/improper-list-length.rkt"
"../base/main.rkt"
"../compound/compose.rkt"
"car-cdr.rkt")
(module+ test

2
lens/list/main.rkt
View File

@ -3,10 +3,12 @@
(require "car-cdr.rkt"
"list-ref-take-drop.rkt"
"cadr-etc.rkt"
"multi.rkt"
"assoc.rkt")
(provide (all-from-out
"car-cdr.rkt"
"list-ref-take-drop.rkt"
"cadr-etc.rkt"
"multi.rkt"
"assoc.rkt"))

1
lens/list/main.scrbl
View File

@ -4,4 +4,5 @@
@include-section["car-cdr.scrbl"]
@include-section["list-ref-take-drop.scrbl"]
@include-section["multi.scrbl"]
@include-section["assoc.scrbl"]

20
unstable/lens/list.rkt → lens/list/multi.rkt
View File

@ -1,20 +1,18 @@
#lang racket
#lang racket/base
(require lens
"join.rkt")
(require racket/contract
"../base/main.rkt"
"../compound/main.rkt"
"../util/rest-contract.rkt"
"list-ref-take-drop.rkt")
(module+ test
(require rackunit))
(provide
(contract-out
[list-ref-nested-lens
(->* () #:rest (listof exact-nonnegative-integer?)
lens?)]
[list-refs-lens
(->* () #:rest (listof exact-nonnegative-integer?)
(lens/c list? list?))]
))
(contract-out
[list-ref-nested-lens (rest-> exact-nonnegative-integer? lens?)]
[list-refs-lens (rest-> exact-nonnegative-integer? (lens/c list? list?))]))
(define (list-ref-nested-lens . indices)

10
unstable/lens/list.scrbl → lens/list/multi.scrbl
View File

@ -1,16 +1,12 @@
#lang scribble/manual
@(require lens/doc-util/main)
@(require "../doc-util/main.rkt")
@title{List Lenses}
@defmodule[unstable/lens/list]
@defproc[(list-ref-nested-lens [index exact-nonnegative-integer?] ...) lens?]{
Constructs a lens that views into a tree made from nested lists.
Indexing starts from zero in the same was as @racket[list-ref-lens].
@lenses-unstable-examples[
@lenses-examples[
(define first-of-second-lens (list-ref-nested-lens 1 0))
(lens-view first-of-second-lens '(1 (a b c) 2 3))
(lens-set first-of-second-lens '(1 (a b c) 2 3) 'foo)
@ -19,7 +15,7 @@
@defproc[(list-refs-lens [index exact-nonnegative-integer?] ...) lens?]{
Constructs a lens that views each @racket[index] item in a list.
Indexing starts from zero in the same was as @racket[list-ref-lens].
@lenses-unstable-examples[
@lenses-examples[
(define 1-5-6-lens (list-refs-lens 1 5 6))
(lens-view 1-5-6-lens '(a b c d e f g))
(lens-set 1-5-6-lens '(a b c d e f g) '(1 2 3))

22
lens/main.rkt
View File

@ -1,20 +1,28 @@
#lang racket
#lang racket/base
(require
"base/main.rkt"
"list/main.rkt"
"struct.rkt"
"compound/main.rkt"
"dict.rkt"
)
"hash/main.rkt"
"list/main.rkt"
"stream.rkt"
"string.rkt"
"struct/main.rkt"
"vector/main.rkt")
(provide
(except-out
(all-from-out
"base/main.rkt"
"list/main.rkt"
"struct.rkt"
"compound/main.rkt"
"dict.rkt"
)
"hash/main.rkt"
"list/main.rkt"
"stream.rkt"
"string.rkt"
"struct/main.rkt"
"vector/main.rkt")
focus-lens
drop-lens
take-lens

11
lens/main.scrbl
View File

@ -1,6 +1,6 @@
#lang scribble/manual
@title{Lenses}
@title[#:style '(toc)]{Lenses}
@defmodule[lens]
@ -14,8 +14,15 @@ representation of getters and setters in object-oriented languages.
source code: @url["https://github.com/jackfirth/lens"]
@local-table-of-contents[]
@include-section["base/main.scrbl"]
@include-section["compound/main.scrbl"]
@include-section["list/main.scrbl"]
@include-section["struct.scrbl"]
@include-section["hash/main.scrbl"]
@include-section["struct/main.scrbl"]
@include-section["vector/main.scrbl"]
@include-section["string.scrbl"]
@include-section["stream.scrbl"]
@include-section["dict.scrbl"]
@include-section["applicable.scrbl"]

10
unstable/lens/stream.rkt → lens/stream.rkt
View File

@ -2,15 +2,15 @@
(provide stream-first-lens
stream-rest-lens
stream-ref-lens
)
stream-ref-lens)
(require racket/stream
fancy-app
lens/base/main
)
"base/main.rkt"
"compound/main.rkt")
(module+ test
(require rackunit lens/test-util/test-lens))
(require rackunit "test-util/test-lens.rkt"))
(define (stream-ref-lens i)
(lens-compose stream-first-lens (stream-tail-lens i)))

10
unstable/lens/stream.scrbl → lens/stream.scrbl
View File

@ -1,27 +1,27 @@
#lang scribble/manual
@(require lens/doc-util/main)
@(require "doc-util/main.rkt")
@title{Stream Lenses}
@defthing[stream-first-lens lens?]{
A lens for viewing the first element of a stream.
@lenses-unstable-examples[
@lenses-examples[
(lens-view stream-first-lens (stream 1 2 3))
(stream->list (lens-set stream-first-lens (stream 1 2 3) 'a))
]}
@defthing[stream-rest-lens lens?]{
A lens for viewing the rest of a stream after the first element.
@lenses-unstable-examples[
@lenses-examples[
(stream->list (lens-view stream-rest-lens (stream 1 2 3)))
(stream->list (lens-set stream-rest-lens (stream 1 2 3) (stream 200 300 400 500)))
]}
@defproc[(stream-ref-lens [i exact-nonnegative-integer?]) lens?]{
A lens for viewing the @racket[i]th element of a stream.
@lenses-unstable-examples[
@lenses-examples[
(lens-view (stream-ref-lens 2) (stream 1 2 3 4 5 6))
(stream->list (lens-set (stream-ref-lens 2) (stream 1 2 3 4 5 6) 'a))
]}

6
unstable/lens/string.rkt → lens/string.rkt
View File

@ -11,9 +11,9 @@
))
(require fancy-app
lens/base/main
lens/util/immutable
"join.rkt")
"base/main.rkt"
"util/immutable.rkt"
"compound/main.rkt")
(module+ test
(require rackunit))

6
unstable/lens/string.scrbl → lens/string.scrbl
View File

@ -1,12 +1,12 @@
#lang scribble/manual
@(require lens/doc-util/main)
@(require "doc-util/main.rkt")
@title{String Lenses}
@defproc[(string-ref-lens [i exact-nonnegative-integer?]) lens?]{
Returns a lens for viewing the @racket[i]th character of a string.
@lenses-unstable-examples[
@lenses-examples[
(lens-view (string-ref-lens 2) "abcdef")
(lens-set (string-ref-lens 2) "abcdef" #\C)
]}
@ -14,7 +14,7 @@ Returns a lens for viewing the @racket[i]th character of a string.
@defproc[(string-pick-lens [i exact-nonnegative-integer?]) lens?]{
Like @racket[list-refs-lens], but for strings.
Equivalent to @racket[(lens-join/string (string-ref-lens i) ...)].
@lenses-unstable-examples[
@lenses-examples[
(define 1-5-6-lens (string-pick-lens 1 5 6))
(lens-view 1-5-6-lens "abcdefg")
(lens-set 1-5-6-lens "abcdefg" "BFG")

11
lens/struct.rkt → lens/struct/field.rkt
View File

@ -1,18 +1,19 @@
#lang racket/base
(provide struct-lens)
(require racket/local
syntax/parse/define
alexis/util/struct
"base/main.rkt"
"../base/main.rkt"
(for-syntax racket/base
syntax/parse
racket/syntax
))
racket/syntax))
(module+ test
(require rackunit fancy-app))
(provide struct-lens)
(define-simple-macro (struct-lens s:id fld:id)
#:with s-fld (format-id #'s "~a-~a" #'s #'fld #:source #'fld)
#:with s-fld-set (format-id #'s "~a-~a-set" #'s #'fld #:source #'fld)

4
lens/struct.scrbl → lens/struct/field.scrbl
View File

@ -1,10 +1,8 @@
#lang scribble/manual
@(require "doc-util/main.rkt")
@(require "../doc-util/main.rkt")
@title{Struct lenses}
@defform[(struct-lens struct-id field-id)]{
Returns a lens for viewing the @racket[field-id] field of
a @racket[struct-id] instance.

8
lens/struct/main.rkt Normal file
View File

@ -0,0 +1,8 @@
#lang racket/base
(require "field.rkt"
"struct.rkt")
(provide
(all-from-out "field.rkt"
"struct.rkt"))

6
lens/struct/main.scrbl Normal file
View File

@ -0,0 +1,6 @@
#lang scribble/manual
@title{Struct Lenses}
@include-section["field.scrbl"]
@include-section["struct.scrbl"]

12
unstable/lens/struct.rkt → lens/struct/struct.rkt
View File

@ -1,8 +1,5 @@
#lang racket/base
(provide define-struct-lenses
struct/lens)
(require syntax/parse/define
lens/base/main
alexis/util/struct
@ -10,12 +7,15 @@
(for-syntax racket/base
syntax/parse
racket/syntax
racket/struct-info
))
racket/struct-info))
(module+ test
(require rackunit
fancy-app
lens/test-util/test-lens))
"../test-util/test-lens.rkt"))
(provide define-struct-lenses
struct/lens)
(define-for-syntax (get-struct-field-ids struct-info failure-context)

21
lens/struct/struct.scrbl Normal file
View File

@ -0,0 +1,21 @@
#lang scribble/manual
@(require "../doc-util/main.rkt")
@defform[(define-struct-lenses struct-id)]{
Given a @racket[struct-id], defines a lens for each of its fields.
@lenses-examples[
(struct foo (a b c) #:transparent)
(define-struct-lenses foo)
(lens-view foo-a-lens (foo 1 2 3))
(lens-set foo-a-lens (foo 1 2 3) 100)
]}
@defform[(struct/lens struct-id (field-spec ...) struct-option ...)]{
Equivalent to @racket[struct] and @racket[define-struct-lenses] combined.
@lenses-examples[
(struct/lens foo (a b c) #:transparent)
(lens-view foo-a-lens (foo 1 2 3))
(lens-set foo-a-lens (foo 1 2 3) 100)
]}

5
lens/test-util/test-lens.rkt
View File

@ -1,6 +1,7 @@
#lang racket
#lang racket/base
(require rackunit
(require racket/contract
rackunit
fancy-app
"../base/base.rkt"
"../base/view-set.rkt")

2
lens/tests/doc-coverage.rkt
View File

@ -1,4 +1,4 @@
#lang racket
#lang racket/base
(require doc-coverage
lens)

22
lens/util/list-pair-contract.rkt
View File

@ -1,10 +1,26 @@
#lang racket
#lang racket/base
(require racket/contract
racket/list
racket/match)
(provide
(contract-out [listof2 (-> contract? contract? contract?)]))
(define (listof2 first-val/c second-val/c)
(define (list*/c . contracts)
(match contracts
[(list end-contract)
end-contract]
[(list* head-contract rest-contracts)
(cons/c head-contract
(apply list*/c rest-contracts))]))
(define (repeating-list/c . contracts)
(define c
(or/c empty? (cons/c first-val/c (cons/c second-val/c (recursive-contract c)))))
(or/c empty?
(apply list*/c (append contracts (list (recursive-contract c))))))
c)
(define (listof2 first-val/c second-val/c)
(repeating-list/c first-val/c second-val/c))

11
lens/util/rest-contract.rkt Normal file
View File

@ -0,0 +1,11 @@
#lang racket/base
(require racket/contract)
(provide
(contract-out
[rest-> (-> contract? contract? contract?)]))
(define (rest-> arg-contract result-contract)
(->* () #:rest (listof arg-contract) result-contract))

12
lens/vector/main.rkt Normal file
View File

@ -0,0 +1,12 @@
#lang racket/base
(require "nested.rkt"
"pick.rkt"
"ref.rkt")
(provide
(all-from-out "nested.rkt"
"pick.rkt"
"ref.rkt"))

7
lens/vector/main.scrbl Normal file
View File

@ -0,0 +1,7 @@
#lang scribble/manual
@title{Vector lenses}
@include-section["ref.scrbl"]
@include-section["nested.scrbl"]
@include-section["pick.scrbl"]

27
lens/vector/nested.rkt Normal file
View File

@ -0,0 +1,27 @@
#lang racket/base
(require racket/contract
"../base/main.rkt"
"../compound/main.rkt"
"../util/immutable.rkt"
"../util/rest-contract.rkt"
"ref.rkt")
(module+ test
(require rackunit))
(provide
(contract-out
[vector-ref-nested-lens (rest-> exact-nonnegative-integer?
(lens/c immutable-vector? any/c))]))
(define (vector-ref-nested-lens . is)
(apply lens-thrush (map vector-ref-lens is)))
(module+ test
(check-equal? (lens-transform (vector-ref-nested-lens 2 1)
#(a #(b c) #(d e f))
symbol->string)
#(a #(b c) #(d "e" f))))

12
lens/vector/nested.scrbl Normal file
View File

@ -0,0 +1,12 @@
#lang scribble/manual
@(require "../doc-util/main.rkt")
@defproc[(vector-ref-nested-lens [i exact-nonnegative-integer?] ...) lens?]{
Like @racket[list-ref-nested-lens], but for vectors.
Equivalent to @racket[(lens-thrush (vector-ref-lens i) ...)].
@lenses-examples[
(lens-view (vector-ref-nested-lens 2 1) #(a b #(s i) d))
(lens-set (vector-ref-nested-lens 2 1) #(a b #(s i) d) "eye")
]}

27
lens/vector/pick.rkt Normal file
View File

@ -0,0 +1,27 @@
#lang racket/base
(require racket/contract
"../base/main.rkt"
"../compound/main.rkt"
"../util/immutable.rkt"
"../util/rest-contract.rkt"
"ref.rkt")
(module+ test
(require rackunit))
(provide
(contract-out
[vector-pick-lens (rest-> exact-nonnegative-integer?
(lens/c immutable-vector? immutable-vector?))]))
(define (vector-pick-lens . is)
(apply lens-join/vector (map vector-ref-lens is)))
(module+ test
(define 1-5-6-lens (vector-pick-lens 1 5 6))
(check-equal? (lens-view 1-5-6-lens #(a b c d e f g))
#(b f g))
(check-equal? (lens-set 1-5-6-lens #(a b c d e f g) #(1 2 3))
#(a 1 c d e 2 3)))

13
lens/vector/pick.scrbl Normal file
View File

@ -0,0 +1,13 @@
#lang scribble/manual
@(require "../doc-util/main.rkt")
@defproc[(vector-pick-lens [i exact-nonnegative-integer?] ...) lens?]{
Like @racket[list-refs-lens], but for vectors.
Equivalent to @racket[(lens-join/vector (vector-ref-lens i) ...)].
@lenses-examples[
(define 1-5-6-lens (vector-pick-lens 1 5 6))
(lens-view 1-5-6-lens #(a b c d e f g))
(lens-set 1-5-6-lens #(a b c d e f g) #(1 2 3))
]}

32
lens/vector/ref.rkt Normal file
View File

@ -0,0 +1,32 @@
#lang racket/base
(require racket/contract
fancy-app
"../base/main.rkt"
"../util/immutable.rkt")
(module+ test
(require rackunit))
(provide
(contract-out
[vector-ref-lens (-> exact-nonnegative-integer?
(lens/c immutable-vector? any/c))]))
(define (vector-ref-lens i)
(make-lens
(vector-ref _ i)
(vector-set _ i _)))
(define (vector-set v i x)
(build-immutable-vector
(vector-length v)
(λ (j)
(if (= i j)
x
(vector-ref v j)))))
(module+ test
(check-equal? (lens-view (vector-ref-lens 0) #(a b c)) 'a)
(check-equal? (lens-set (vector-ref-lens 2) #(a b c) "C") #(a b "C")))

11
lens/vector/ref.scrbl Normal file
View File

@ -0,0 +1,11 @@
#lang scribble/manual
@(require "../doc-util/main.rkt")
@defproc[(vector-ref-lens [i exact-nonnegative-integer?]) lens?]{
Returns a lens that views an element of a vector.
@lenses-examples[
(lens-view (vector-ref-lens 2) #(a b c d))
(lens-set (vector-ref-lens 2) #(a b c d) "sea")
]}

9
unstable/lens/arrow.rkt
View File

@ -5,10 +5,10 @@
lens-transform~>
lens-view/thrush
lens-set/thrush
lens-transform/thrush
)
lens-transform/thrush)
(require lens)
(require lens/base/main)
(module+ test
(require rackunit racket/list fancy-app))
@ -38,5 +38,4 @@
(check-equal? (lens-set~> '((1 2) 3) first-lens second-lens #:-> 'two)
'((1 two) 3))
(check-equal? (lens-transform~> '((1 2) 3) first-lens second-lens #:-> (* 100 _))
'((1 200) 3))
)
'((1 200) 3)))

30
unstable/lens/hash-pick.rkt
View File

@ -1,30 +0,0 @@
#lang racket/base
(require racket/contract/base)
(provide (contract-out
[hash-pick-lens
(->* [] #:rest list? (lens/c immutable-hash? immutable-hash?))]
))
(require racket/list
lens/base/main
lens/util/immutable
"hash.rkt"
"join.rkt")
(module+ test
(require rackunit))
(define (hash-pick-lens . ks)
(apply lens-join/hash
(append-map
(λ (k)
(list k (hash-ref-lens k)))
ks)))
(module+ test
(check-equal? (lens-view (hash-pick-lens 'a 'c) (hash 'a 1 'b 2 'c 3))
(hash 'a 1 'c 3))
(check-equal? (lens-set (hash-pick-lens 'a 'c) (hash 'a 1 'b 2 'c 3) (hash 'a 4 'c 5))
(hash 'a 4 'b 2 'c 5))
)

16
unstable/lens/hash-pick.scrbl
View File

@ -1,16 +0,0 @@
#lang scribble/manual
@(require lens/doc-util/main)
@title{Viewing a subset of a hash table by key}
@defmodule[unstable/lens/hash-pick]
@defproc[(hash-pick-lens [key any/c] ...) lens?]{
Creates a lens that views a subset of the target hash-table with the given
@racket[key]s. The view, is another hash-table with only the given keys and
their corrosponding values in the target hash-table.
@lenses-unstable-examples[
(lens-view (hash-pick-lens 'a 'c) (hash 'a 1 'b 2 'c 3))
(lens-set (hash-pick-lens 'a 'c) (hash 'a 1 'b 2 'c 3) (hash 'a 4 'c 5))
]}

36
unstable/lens/hash.rkt
View File

@ -1,36 +0,0 @@
#lang racket
(provide
(contract-out
[hash-ref-lens (-> any/c (lens/c immutable-hash? any/c))]
[hash-ref-nested-lens (->* () #:rest list? (lens/c immutable-hash? any/c))]))
(require fancy-app
lens
lens/util/immutable
)
(module+ test
(require rackunit))
(define (hash-ref-lens key)
(make-lens (hash-ref _ key)
(hash-set _ key _)))
(define (hash-ref-nested-lens . keys)
(apply lens-thrush (map hash-ref-lens keys)))
(module+ test
(define a (hash-ref-lens 'a))
(define a-x (hash-ref-nested-lens 'a 'x))
(let-lens [val ctxt] a (hash 'a 1 'b 2 'c 3)
(check-equal? val 1)
(check-equal? (ctxt 100) (hash 'a 100 'b 2 'c 3)))
(check-equal? (lens-transform/list (hash 'a 1 'b 2 'c 3) a (* 10 _))
(hash 'a 10 'b 2 'c 3))
(let-lens [val ctxt] a-x (hash 'a (hash 'x 1 'y 2) 'b (hash 'z 3))
(check-equal? val 1)
(check-equal? (ctxt 100) (hash 'a (hash 'x 100 'y 2) 'b (hash 'z 3))))
(check-equal? (lens-transform/list (hash 'a (hash 'x 1 'y 2) 'b (hash 'z 3)) a-x (* 10 _))
(hash 'a (hash 'x 10 'y 2) 'b (hash 'z 3))))

27
unstable/lens/hash.scrbl
View File

@ -1,27 +0,0 @@
#lang scribble/manual
@(require lens/doc-util/main)
@title{Hash Lenses}
@defmodule[unstable/lens/hash]
@defproc[(hash-ref-lens [key any/c]) lens?]{
Constructs a lens that targets hashes and views the value
of @racket[key].
@lenses-unstable-examples[
(define foo-lens (hash-ref-lens 'foo))
(lens-view foo-lens (hash 'foo 10 'bar 20))
(lens-set foo-lens (hash 'foo 10 'bar 20) 1000)
]}
@defproc[(hash-ref-nested-lens [key any/c] ...) lens?]{
Contructs a lens that targets hashes with nested hashes
as values and views the value obtained by using each
@racket[key] in order.
@lenses-unstable-examples[
(define foo-bar-lens (hash-ref-nested-lens 'foo 'bar))
(lens-view foo-bar-lens (hash 'foo (hash 'bar 1)))
(lens-set foo-bar-lens (hash 'foo (hash 'bar 1)) 1000)
]}

117
unstable/lens/join.rkt
View File

@ -1,117 +0,0 @@
#lang racket
(require fancy-app
lens
lens/util/list-pair-contract
lens/util/immutable
unstable/sequence)
(module+ test
(require rackunit))
(provide
(contract-out
[lens-join/list (->* () #:rest (listof lens?) (lens/c any/c list?))]
[lens-join/hash (->* () #:rest (listof2 any/c lens?) (lens/c any/c immutable-hash?))]
[lens-join/vector (->* () #:rest (listof lens?) (lens/c any/c immutable-vector?))]
[lens-join/string (->* () #:rest (listof lens?) (lens/c any/c immutable-string?))]
))
(define (zip xs ys)
(append-map list xs ys))
(define (lens-join/list . lenses)
(define (get target)
(apply lens-view/list target lenses))
(define (set target new-views)
(apply lens-set/list target (zip lenses new-views)))
(make-lens get set))
(module+ test
(define first-third-fifth-lens
(lens-join/list first-lens
third-lens
fifth-lens))
(check-equal? (lens-view first-third-fifth-lens '(a b c d e f))
'(a c e))
(check-equal? (lens-set first-third-fifth-lens '(a b c d e f) '(1 2 3))
'(1 b 2 d 3 f)))
(define first-first-lens
(lens-join/list first-lens
first-lens))
(define (value-list->hash keys vs)
(make-immutable-hash (map cons keys vs)))
(define (split-slice n vs)
(define grouped
(for/list ([group (in-slice n vs)])
group))
(define (get-ith i)
(map (list-ref _ i) grouped))
(build-list n get-ith))
(module+ test
(check-equal? (split-slice 3 '(a 1 FOO b 2 BAR c 3 BAZ))
'((a b c) (1 2 3) (FOO BAR BAZ))))
(define (lens-join/hash . keys/lenses)
(match-define (list keys lenses) (split-slice 2 keys/lenses))
(define list-lens (apply lens-join/list lenses))
(define (get target)
(value-list->hash keys (lens-view list-lens target)))
(define (set target new-view-hash)
(lens-set list-lens target (map (hash-ref new-view-hash _) keys)))
(make-lens get set))
(module+ test
(define a-b-lens (lens-join/hash 'b third-lens
'a first-lens))
(check-equal? (lens-view a-b-lens '(1 2 3))
(hash 'a 1 'b 3))
(check-equal? (lens-set a-b-lens '(1 2 3) (hash 'a 100 'b 200))
'(100 2 200)))
(define (lens-join/vector . lenses)
(lens-compose list->vector-lens (apply lens-join/list lenses)))
(define (inverse-function-lens f f-inv)
(make-lens
(λ (tgt) (f tgt))
(λ (tgt v) (f-inv v))))
(define list->vector-lens
(inverse-function-lens list->immutable-vector vector->list))
(module+ test
(define vector-first-third-fifth-lens
(lens-join/vector first-lens
third-lens
fifth-lens))
(check-equal? (lens-view vector-first-third-fifth-lens '(a b c d e f))
#(a c e))
(check-pred immutable? (lens-view vector-first-third-fifth-lens '(a b c d e f)))
(check-equal? (lens-set vector-first-third-fifth-lens '(a b c d e f) #(1 2 3))
'(1 b 2 d 3 f)))
(define (lens-join/string . lenses)
(lens-compose list->string-lens (apply lens-join/list lenses)))
(define list->string-lens
(inverse-function-lens list->immutable-string string->list))
(module+ test
(define string-first-third-fifth-lens
(lens-join/string first-lens
third-lens
fifth-lens))
(check-equal? (lens-view string-first-third-fifth-lens '(#\a #\b #\c #\d #\e #\f))
"ace")
(check-pred immutable? (lens-view string-first-third-fifth-lens '(#\a #\b #\c #\d #\e #\f)))
(check-equal? (lens-set string-first-third-fifth-lens '(#\a #\b #\c #\d #\e #\f) "ACE")
'(#\A #\b #\C #\d #\E #\f)))

59
unstable/lens/join.scrbl
View File

@ -1,59 +0,0 @@
#lang scribble/manual
@(require lens/doc-util/main)
@title{Joining Lenses}
@defmodule[unstable/lens/join]
@defproc[(lens-join/list [lens lens?] ...) lens?]{
Constructs a lens that combines the view of each
@racket[lens] into a list of views. This lens can
be used to view and set a list of values in a single
target. If any of the lenses share views, then when
setting the later lenses override the earlier ones.
@lenses-unstable-examples[
(define first-third-fifth-lens
(lens-join/list first-lens
third-lens
fifth-lens))
(lens-view first-third-fifth-lens '(a b c d e f))
(lens-set first-third-fifth-lens '(a b c d e f) '(1 2 3))
]}
@defproc[(lens-join/hash [key any/c] [lens lens?] ... ...) lens?]{
Constructs a lens that combines the view of each
@racket[lens] into a hash of views with @racket[key]s
as the hash keys. In the same manner as @racket[lens-join/list],
if lenses share views later lenses take precedence when
setting.
@lenses-unstable-examples[
(define a-b-lens (lens-join/hash 'a first-lens
'b third-lens))
(lens-view a-b-lens '(1 2 3))
(lens-set a-b-lens '(1 2 3) (hash 'a 100 'b 200))
]}
@defproc[(lens-join/vector [lens lens?] ...) lens?]{
Like @racket[lens-join/list], except the view is a vector, not a list.
@lenses-unstable-examples[
(define vector-first-third-fifth-lens
(lens-join/vector first-lens
third-lens
fifth-lens))
(lens-view vector-first-third-fifth-lens '(a b c d e f))
(lens-set vector-first-third-fifth-lens '(a b c d e f) #(1 2 3))
]}
@defproc[(lens-join/string [lens lens?] ...) lens?]{
Like @racket[lens-join/list], except the view is a string, not a list.
Each @racket[lens] argument must return a @racket[char?] as a view.
@lenses-unstable-examples[
(define string-first-third-fifth-lens
(lens-join/string first-lens
third-lens
fifth-lens))
(lens-view string-first-third-fifth-lens '(#\a #\b #\c #\d #\e #\f))
(lens-set string-first-third-fifth-lens '(#\a #\b #\c #\d #\e #\f) "ACE")
]}

24
unstable/lens/main.rkt
View File

@ -1,29 +1,11 @@
#lang racket
#lang racket/base
(require "syntax.rkt"
"join.rkt"
"list.rkt"
"hash.rkt"
"vector.rkt"
"string.rkt"
"view-set.rkt"
"sublist.rkt"
"struct.rkt"
"arrow.rkt"
"hash-pick.rkt"
"stream.rkt"
)
"arrow.rkt")
(provide (all-from-out "syntax.rkt"
"join.rkt"
"list.rkt"
"hash.rkt"
"vector.rkt"
"string.rkt"
"view-set.rkt"
"sublist.rkt"
"struct.rkt"
"arrow.rkt"
"hash-pick.rkt"
"stream.rkt"
))
"arrow.rkt"))

8
unstable/lens/main.scrbl
View File

@ -10,14 +10,6 @@ may change in future releases. Do not depend on
this library being backwards-compatible.
@include-section["view-set.scrbl"]
@include-section["join.scrbl"]
@include-section["list.scrbl"]
@include-section["hash.scrbl"]
@include-section["vector.scrbl"]
@include-section["string.scrbl"]
@include-section["syntax.scrbl"]
@include-section["sublist.scrbl"]
@include-section["struct.scrbl"]
@include-section["arrow.scrbl"]
@include-section["hash-pick.scrbl"]
@include-section["stream.scrbl"]

24
unstable/lens/struct.scrbl
View File

@ -1,24 +0,0 @@
#lang scribble/manual
@(require lens/doc-util/main)
@title{Defining struct lenses automatically}
@defmodule[unstable/lens/struct]
@defform[(define-struct-lenses struct-id)]{
Given a @racket[struct-id], defines lenses for the fields.
@lenses-unstable-examples[
(struct foo (a b c) #:transparent)
(define-struct-lenses foo)
(lens-view foo-a-lens (foo 1 2 3))
(lens-set foo-a-lens (foo 1 2 3) 100)
]}
@defform[(struct/lens struct-id (field-spec ...) struct-option ...)]{
Equivalent to @racket[struct] and @racket[define-struct-lenses] combined.
@lenses-unstable-examples[
(struct/lens foo (a b c) #:transparent)
(lens-view foo-a-lens (foo 1 2 3))
(lens-set foo-a-lens (foo 1 2 3) 100)
]}

6
unstable/lens/sublist.rkt
View File

@ -2,9 +2,9 @@
(provide sublist-lens)
(require lens/base/main
lens/list/main
)
(require lens
lens/list/list-ref-take-drop)
(module+ test
(require rackunit))

62
unstable/lens/vector.rkt
View File

@ -1,62 +0,0 @@
#lang racket/base
(require racket/contract/base)
(provide (contract-out
[vector-ref-lens
(-> exact-nonnegative-integer?
(lens/c immutable-vector? any/c))]
[vector-ref-nested-lens
(->* [] #:rest (listof exact-nonnegative-integer?)
(lens/c immutable-vector? any/c))]
[vector-pick-lens
(->* [] #:rest (listof exact-nonnegative-integer?)
(lens/c immutable-vector? immutable-vector?))]
))
(require fancy-app
lens/base/main
lens/util/immutable
"arrow.rkt"
"join.rkt")
(module+ test
(require rackunit))
(define (vector-ref-lens i)
(make-lens
(vector-ref _ i)
(vector-set _ i _)))
(define (vector-set v i x)
(build-immutable-vector
(vector-length v)
(λ (j)
(if (= i j)
x
(vector-ref v j)))))
(module+ test
(check-equal? (lens-view (vector-ref-lens 0) #(a b c)) 'a)
(check-equal? (lens-set (vector-ref-lens 2) #(a b c) "C") #(a b "C")))
(define (vector-ref-nested-lens . is)
(apply lens-thrush (map vector-ref-lens is)))
(module+ test
(check-equal? (lens-transform (vector-ref-nested-lens 2 1)
#(a #(b c) #(d e f))
symbol->string)
#(a #(b c) #(d "e" f))))
(define (vector-pick-lens . is)
(apply lens-join/vector (map vector-ref-lens is)))
(module+ test
(define 1-5-6-lens (vector-pick-lens 1 5 6))
(check-equal? (lens-view 1-5-6-lens #(a b c d e f g))
#(b f g))
(check-equal? (lens-set 1-5-6-lens #(a b c d e f g) #(1 2 3))
#(a 1 c d e 2 3)))

29
unstable/lens/vector.scrbl
View File

@ -1,29 +0,0 @@
#lang scribble/manual
@(require lens/doc-util/main)
@title{Vector lenses}
@defproc[(vector-ref-lens [i exact-nonnegative-integer?]) lens?]{
Returns a lens that views an element of a vector.
@lenses-unstable-examples[
(lens-view (vector-ref-lens 2) #(a b c d))
(lens-set (vector-ref-lens 2) #(a b c d) "sea")
]}
@defproc[(vector-ref-nested-lens [i exact-nonnegative-integer?] ...) lens?]{
Like @racket[list-ref-nested-lens], but for vectors.
Equivalent to @racket[(lens-thrush (vector-ref-lens i) ...)].
@lenses-unstable-examples[
(lens-view (vector-ref-nested-lens 2 1) #(a b #(s i) d))
(lens-set (vector-ref-nested-lens 2 1) #(a b #(s i) d) "eye")
]}
@defproc[(vector-pick-lens [i exact-nonnegative-integer?] ...) lens?]{
Like @racket[list-refs-lens], but for vectors.
Equivalent to @racket[(lens-join/vector (vector-ref-lens i) ...)].
@lenses-unstable-examples[
(define 1-5-6-lens (vector-pick-lens 1 5 6))
(lens-view 1-5-6-lens #(a b c d e f g))
(lens-set 1-5-6-lens #(a b c d e f g) #(1 2 3))
]}