suzanne.soy/lens
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add struct-lenses-out and struct+lenses-out

Browse Source
This commit is contained in:
AlexKnauth 2015-09-27 00:54:54 -04:00
parent 69dcc57a21
commit 669aff7cdf
1 changed files with 16 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
lens/private/struct/struct.rkt
View File

@ -2,6 +2,7 @@
(require syntax/parse/define
alexis/util/struct
racket/provide-syntax
"../base/main.rkt"
(submod alexis/util/struct get-struct-accessors)
(for-syntax racket/base
@ -15,7 +16,9 @@
"../test-util/test-lens.rkt"))
(provide define-struct-lenses
struct/lens)
struct/lens
struct-lenses-out
struct+lenses-out)
(define-for-syntax (get-struct-field-ids struct-info failure-context)
@ -55,6 +58,18 @@
(struct s (field-spec ...) option ...)
(define-struct-lenses s)))
(define-provide-syntax struct-lenses-out
(syntax-parser
[(struct-lenses-out struct-type:id)
#:do [(define field-ids (get-struct-id-field-ids #'struct-type))]
#:with [lens-id ...] (map-format-id #'struct-type "~a-lens" field-ids)
#'(combine-out lens-id ...)]))
(define-provide-syntax struct+lenses-out
(syntax-parser
[(struct+lenses-out struct-type:id)
#'(combine-out (struct-out struct-type) (struct-lenses-out struct-type))]))
(module+ test
(struct/lens foo (a b c d) #:transparent)
(check-lens-view foo-b-lens (foo 1 2 3 4) 2)