From 13764a070e4d58e876ae6a76ef2cad1d24692cc1 Mon Sep 17 00:00:00 2001
From: Jack Firth <jackhfirth@gmail.com>
Date: Fri, 10 Jul 2015 14:29:08 -0700
Subject: [PATCH 1/4] Add compound hash lens

---
 unstable/lens/compound.rkt | 27 ++++++++++++++++++++++++++-
 1 file changed, 26 insertions(+), 1 deletion(-)

diff --git a/unstable/lens/compound.rkt b/unstable/lens/compound.rkt
index 6f38a4e..1bf635f 100644
--- a/unstable/lens/compound.rkt
+++ b/unstable/lens/compound.rkt
@@ -1,6 +1,7 @@
 #lang racket
 
-(require lens)
+(require lens
+         unstable/sequence)
 
 (module+ test
   (require rackunit))
@@ -33,3 +34,27 @@
 (define first-first-lens
   (compound-list-lens first-lens
                       first-lens))
+
+
+(define (compound-hash-lens . keys/lenses)
+  (define grouped-keys/lenses
+    (for/list ([key/lens (in-slice 2 keys/lenses)])
+      key/lens))
+  (define keys (map first grouped-keys/lenses))
+  (define lenses (map second grouped-keys/lenses))
+  (define list-lens (apply compound-list-lens lenses))
+  (define (value-list->hash keys xs)
+    (make-immutable-hash (map cons keys xs)))
+  (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)))

From f8d324863c1c047ce3c0e1ba01542d453f79b9f0 Mon Sep 17 00:00:00 2001
From: Jack Firth <jackhfirth@gmail.com>
Date: Fri, 10 Jul 2015 14:40:05 -0700
Subject: [PATCH 2/4] Refactoring

---
 unstable/lens/compound.rkt | 27 +++++++++++++++++++--------
 1 file changed, 19 insertions(+), 8 deletions(-)

diff --git a/unstable/lens/compound.rkt b/unstable/lens/compound.rkt
index 1bf635f..467d92a 100644
--- a/unstable/lens/compound.rkt
+++ b/unstable/lens/compound.rkt
@@ -1,6 +1,7 @@
 #lang racket
 
-(require lens
+(require fancy-app
+         lens
          unstable/sequence)
 
 (module+ test
@@ -36,15 +37,25 @@
                       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)
-  (define grouped-keys/lenses
-    (for/list ([key/lens (in-slice 2 keys/lenses)])
-      key/lens))
-  (define keys (map first grouped-keys/lenses))
-  (define lenses (map second grouped-keys/lenses))
+  (match-define (list keys lenses) (split-slice 2 keys/lenses))
   (define list-lens (apply compound-list-lens lenses))
-  (define (value-list->hash keys xs)
-    (make-immutable-hash (map cons keys xs)))
   (define (get target)
     (value-list->hash keys (lens-view list-lens target)))
   (define (set target new-view-hash)

From 7e4721bb12594b1cc2841bbf84fb2c249b437ab0 Mon Sep 17 00:00:00 2001
From: Jack Firth <jackhfirth@gmail.com>
Date: Fri, 10 Jul 2015 14:43:40 -0700
Subject: [PATCH 3/4] Expose and contract

---
 unstable/lens/compound.rkt | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/unstable/lens/compound.rkt b/unstable/lens/compound.rkt
index 467d92a..cae2a16 100644
--- a/unstable/lens/compound.rkt
+++ b/unstable/lens/compound.rkt
@@ -2,6 +2,7 @@
 
 (require fancy-app
          lens
+         lens/list-pair-contract
          unstable/sequence)
 
 (module+ test
@@ -9,7 +10,8 @@
 
 (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)

From 0914dc805e87b29c67edc4416ea2d11c571f3d3b Mon Sep 17 00:00:00 2001
From: Jack Firth <jackhfirth@gmail.com>
Date: Fri, 10 Jul 2015 14:52:41 -0700
Subject: [PATCH 4/4] Add docs

---
 unstable/lens/compound.scrbl | 13 +++++++++++++
 1 file changed, 13 insertions(+)

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