From 71b070749e2759b10259439a7c92a56c23cf19f5 Mon Sep 17 00:00:00 2001
From: AlexKnauth <alexander@knauth.org>
Date: Sun, 5 Jul 2015 22:59:05 -0400
Subject: [PATCH] add struct-lens

closes https://github.com/jackfirth/lenses/issues/32
---
 info.rkt               |  4 +++-
 lenses/struct-lens.rkt | 31 +++++++++++++++++++++++++++++++
 2 files changed, 34 insertions(+), 1 deletion(-)
 create mode 100644 lenses/struct-lens.rkt

diff --git a/info.rkt b/info.rkt
index 26cd020..a06c389 100644
--- a/info.rkt
+++ b/info.rkt
@@ -6,7 +6,9 @@
 (define deps
   '("base"
     "rackunit-lib"
-    "fancy-app"))
+    "fancy-app"
+    "alexis-util"
+    ))
 
 
 (define build-deps
diff --git a/lenses/struct-lens.rkt b/lenses/struct-lens.rkt
new file mode 100644
index 0000000..21fd9e6
--- /dev/null
+++ b/lenses/struct-lens.rkt
@@ -0,0 +1,31 @@
+#lang racket/base
+
+(provide struct-lens)
+
+(require racket/local
+         syntax/parse/define
+         alexis/util/struct
+         "main.rkt"
+         (for-syntax racket/base
+                     syntax/parse
+                     racket/syntax
+                     ))
+(module+ test
+  (require rackunit fancy-app (only-in lenses lens-transform*)))
+
+(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)
+  (local [(define-struct-updaters s)]
+    (make-lens s-fld s-fld-set)))
+
+(module+ test
+  (struct foo (a b c) #:transparent)
+  (define foo-a-lens (struct-lens foo a))
+  (define foo-b-lens (struct-lens foo b))
+  (define foo-c-lens (struct-lens foo c))
+  (define f (foo 1 2 3))
+  (check-equal? (lens-transform* f foo-a-lens (* 100 _)) (foo 100 2 3))
+  (check-equal? (lens-transform* f foo-b-lens (* 100 _)) (foo 1 200 3))
+  (check-equal? (lens-transform* f foo-c-lens (* 100 _)) (foo 1 2 300))
+  )