diff --git a/unstable/lens/compound.rkt b/unstable/lens/compound.rkt index 6f38a4e..cae2a16 100644 --- a/unstable/lens/compound.rkt +++ b/unstable/lens/compound.rkt @@ -1,13 +1,17 @@ #lang racket -(require lens) +(require fancy-app + lens + lens/list-pair-contract + unstable/sequence) (module+ test (require rackunit)) (provide (contract-out - [compound-list-lens (->* () #:rest (listof lens?) lens?)])) + [compound-list-lens (->* () #:rest (listof lens?) lens?)] + [compound-hash-lens (->* () #:rest (listof2 any/c lens?) lens?)])) (define (zip xs ys) @@ -33,3 +37,37 @@ (define first-first-lens (compound-list-lens 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 (compound-hash-lens . keys/lenses) + (match-define (list keys lenses) (split-slice 2 keys/lenses)) + (define list-lens (apply compound-list-lens lenses)) + (define (get target) + (value-list->hash keys (lens-view list-lens target))) + (define (set target new-view-hash) + (lens-set list-lens target (hash-values new-view-hash))) + (make-lens get set)) + +(module+ test + (define a-b-lens (compound-hash-lens 'a first-lens + 'b third-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))) diff --git a/unstable/lens/compound.scrbl b/unstable/lens/compound.scrbl index 20633d2..f2f013c 100644 --- a/unstable/lens/compound.scrbl +++ b/unstable/lens/compound.scrbl @@ -21,3 +21,16 @@ (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[(compound-hash-lens [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[compound-list-lens], + if lenses share views later lenses take precedence when + setting. + @lenses-unstable-examples[ + (define a-b-lens (compound-hash-lens '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)) +]}