From 1af475b44ff333141b018e894ce0b42aa284f4b6 Mon Sep 17 00:00:00 2001
From: AlexKnauth <alexander@knauth.org>
Date: Fri, 26 Jun 2015 16:40:06 -0400
Subject: [PATCH] add hash-ref-lens

---
 lenses/hash.rkt | 32 ++++++++++++++++++++++++++++++++
 1 file changed, 32 insertions(+)
 create mode 100644 lenses/hash.rkt

diff --git a/lenses/hash.rkt b/lenses/hash.rkt
new file mode 100644
index 0000000..e224829
--- /dev/null
+++ b/lenses/hash.rkt
@@ -0,0 +1,32 @@
+#lang racket/base
+
+(provide hash-ref-lens)
+
+(require fancy-app
+         "core.rkt"
+         )
+(module+ test
+  (require rackunit))
+
+(define ((hash-ref-lens1 key) hash)
+  (values (hash-ref hash key)
+          (hash-set hash key _))) ; fancy-app
+
+(define (hash-ref-lens . keys)
+  (apply lens-thrush (map hash-ref-lens1 keys)))
+
+(module+ test
+  (define a (hash-ref-lens 'a))
+  (define a-x (hash-ref-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* (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* (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)))
+  )
+