diff --git a/unstable/lens/main.rkt b/unstable/lens/main.rkt index 3ffba54..bdc0389 100644 --- a/unstable/lens/main.rkt +++ b/unstable/lens/main.rkt @@ -6,6 +6,7 @@ "hash.rkt" "view-set.rkt" "sublist.rkt" + "struct.rkt" ) (provide (all-from-out "syntax.rkt" @@ -14,4 +15,5 @@ "hash.rkt" "view-set.rkt" "sublist.rkt" + "struct.rkt" )) diff --git a/unstable/lens/main.scrbl b/unstable/lens/main.scrbl index 3b525f3..8ee9a58 100644 --- a/unstable/lens/main.scrbl +++ b/unstable/lens/main.scrbl @@ -15,3 +15,4 @@ this library being backwards-compatible. @include-section["hash.scrbl"] @include-section["syntax.scrbl"] @include-section["sublist.scrbl"] +@include-section["struct.scrbl"] diff --git a/unstable/lens/struct.rkt b/unstable/lens/struct.rkt new file mode 100644 index 0000000..71ef2c4 --- /dev/null +++ b/unstable/lens/struct.rkt @@ -0,0 +1,46 @@ +#lang racket/base + +(provide define-struct-lenses struct/lens) + +(require syntax/parse/define + lens/base/main + alexis/util/struct + (submod alexis/util/struct get-struct-accessors) + (for-syntax racket/base + syntax/parse + racket/syntax + racket/struct-info + )) +(module+ test + (require rackunit fancy-app)) + +(define-syntax define-struct-lenses + (syntax-parser + [(define-struct-lenses s:id) + #:do [(define-values (ids1 ids2) + (get-struct-accessors (extract-struct-info (syntax-local-value #'s)) #'s))] + #:with [s-fld:id ...] ids2 + #:with [[s-fld-set s-fld-lens] ...] + (for/list ([s-fld (in-list ids2)]) + (list (format-id #'s "~a-set" s-fld #:source s-fld) + (format-id #'s "~a-lens" s-fld #:source s-fld))) + #'(begin + (define-struct-updaters s) + (define s-fld-lens (make-lens s-fld s-fld-set)) + ...)])) + +(define-simple-macro (struct/lens s:id (field-spec ...) option ...) + (begin + (struct s (field-spec ...) option ...) + (define-struct-lenses s))) + +(module+ test + (require rackunit) + (struct/lens foo (a b c) #:transparent) + (check-equal? (lens-transform foo-a-lens (foo 1 2 3) (* 100 _)) + (foo 100 2 3)) + (struct bar foo (d e f) #:transparent) + (define-struct-lenses bar) + (check-equal? (lens-transform bar-d-lens (bar 1 2 3 4 5 6) (* 100 _)) + (bar 1 2 3 400 5 6)) + ) diff --git a/unstable/lens/struct.scrbl b/unstable/lens/struct.scrbl new file mode 100644 index 0000000..bfb566e --- /dev/null +++ b/unstable/lens/struct.scrbl @@ -0,0 +1,24 @@ +#lang scribble/manual + +@(require lens/doc-util/main) + +@title{Defining struct lenses automatically} + +@defmodule[unstable/lens/struct] + +@defform[(define-struct-lenses struct-id)]{ +Given a @racket[struct-id], defines lenses for the fields. +@lenses-unstable-examples[ + (struct foo (a b c) #:transparent) + (define-struct-lenses foo) + (lens-view foo-a-lens (foo 1 2 3)) + (lens-set foo-a-lens (foo 1 2 3) 100) +]} + +@defform[(struct/lens struct-id (field-spec ...) struct-option ...)]{ +Equivalent to @racket[struct] and @racket[define-struct-lenses] combined. +@lenses-unstable-examples[ + (struct/lens foo (a b c) #:transparent) + (lens-view foo-a-lens (foo 1 2 3)) + (lens-set foo-a-lens (foo 1 2 3) 100) +]}