Merge pull request #36 from AlexKnauth/struct-lens2

add struct-lens, closes #32 and closes #41

info.rkt

@@ -6,7 +6,9 @@
 (define deps
   '("base"
     "rackunit-lib"
-    "fancy-app"))
+    "fancy-app"
+    "alexis-util"
+    ))
 
 
 (define build-deps

lenses/deflenses.rkt

@@ -1,7 +1,7 @@
 #lang racket
 
 (require scribble/manual
-         "main.rkt")
+         (for-label lenses))
 
 (provide deflens
          deflenses)

lenses/info.rkt

@@ -1,4 +1,4 @@
 #lang info
 
 (define name "lenses")
-(define scribblings '(("main.scrbl" () () "lenses")))
+(define scribblings '(("main.scrbl" () (library) "lenses")))

lenses/main.scrbl

@@ -15,5 +15,6 @@ source code: @url["https://github.com/jackfirth/lenses"]
 
 @include-section["core/main.scrbl"]
 @include-section["list/main.scrbl"]
+@include-section["struct-lens.scrbl"]
 @include-section["syntax.scrbl"]
 @include-section["applicable.scrbl"]

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

lenses/struct-lens.scrbl

@@ -0,0 +1,24 @@
+#lang scribble/manual
+
+@(require scribble/eval
+          "lenses-examples.rkt"
+          (for-label lenses
+                     lenses/struct-lens
+                     racket/base
+                     racket/contract))
+
+
+@title{Struct lenses}
+
+@defmodule[lenses/struct-lens]
+
+@defform[(struct-lens struct-id field-id)]{
+  Returns a lens for viewing the @racket[field-id] field of
+  a @racket[struct-id] instance.
+  @lenses-examples[
+    (require lenses/struct-lens)
+    (struct foo (a b c) #:transparent)
+    (lens-view (struct-lens foo a) (foo 1 2 3))
+    (lens-set (struct-lens foo a) (foo 1 2 3) 100)
+]}
+