From 669aff7cdf43b35802a14793a43ed3295c5b9143 Mon Sep 17 00:00:00 2001 From: AlexKnauth Date: Sun, 27 Sep 2015 00:54:54 -0400 Subject: [PATCH] add struct-lenses-out and struct+lenses-out --- lens/private/struct/struct.rkt | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/lens/private/struct/struct.rkt b/lens/private/struct/struct.rkt index d3fcd61..c5ef31d 100644 --- a/lens/private/struct/struct.rkt +++ b/lens/private/struct/struct.rkt @@ -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)