Merge pull request #98 from jackfirth/compound-hash-#16

Add compound hash lens

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

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))
+]}