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

Reorganize and add new folders

Browse Source
This commit is contained in:
Jack Firth 2015-08-18 15:34:01 -07:00
parent efe8628e2c
commit 614d6876c7
41 changed files with 463 additions and 285 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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"))

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))))

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

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)))

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)))

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)))

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)))

0
lens/join.scrbl → lens/compound/join.scrbl
View File

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"))

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))))

30
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
"base/main.rkt"
"util/immutable.rkt"
"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))
)

21
lens/hash.rkt → lens/hash/hash.rkt
View File

@ -1,16 +1,19 @@
#lang racket
#lang racket/base
(require racket/contract
fancy-app
"../base/main.rkt"
"../compound/main.rkt"
"../util/immutable.rkt"
"../util/rest-contract.rkt")
(module+ test
(require rackunit))
(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
"base/main.rkt"
"util/immutable.rkt")
(module+ test
(require rackunit))
[hash-ref-nested-lens (rest-> any/c (lens/c immutable-hash? any/c))]))
(define (hash-ref-lens key)

0
lens/hash.scrbl → lens/hash/hash.scrbl
View File

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

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

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"
"hash.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)))

0
lens/hash-pick.scrbl → lens/hash/pick.scrbl
View File

118
lens/join.rkt
View File

@ -1,118 +0,0 @@
#lang racket
(require fancy-app
"base/main.rkt"
"list/main.rkt"
"util/list-pair-contract.rkt"
"util/immutable.rkt"
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)))

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"))

21
lens/list.rkt → lens/list/multi.rkt
View File

@ -1,21 +1,18 @@
#lang racket
#lang racket/base
(require "base/main.rkt"
"list/main.rkt"
"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)

0
lens/list.scrbl → lens/list/multi.scrbl
View File

20
lens/main.rkt
View File

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

3
lens/stream.rkt
View File

@ -6,7 +6,8 @@
(require racket/stream
fancy-app
"base/main.rkt")
"base/main.rkt"
"compound/main.rkt")
(module+ test
(require rackunit "test-util/test-lens.rkt"))

2
lens/string.rkt
View File

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

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)

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

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"))

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)

0
unstable/lens/struct.scrbl → lens/struct/struct.scrbl
View File

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))

62
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
"base/main.rkt"
"list/main.rkt"
"util/immutable.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)))

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"))

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))))

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)))

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")))

0
lens/vector.scrbl → lens/vector/ref.scrbl
View File