Merge pull request #220 from AlexKnauth/struct+lenses-out
add struct-lenses-out and struct+lenses-out
This commit is contained in:
commit
c19451323e
|
@ -1,3 +1,5 @@
|
||||||
#lang reprovide
|
#lang sweet-exp reprovide
|
||||||
"field.rkt"
|
"field.rkt"
|
||||||
"struct.rkt"
|
except-in "struct.rkt"
|
||||||
|
struct-lenses-out
|
||||||
|
struct+lenses-out
|
||||||
|
|
|
@ -2,6 +2,7 @@
|
||||||
|
|
||||||
(require syntax/parse/define
|
(require syntax/parse/define
|
||||||
alexis/util/struct
|
alexis/util/struct
|
||||||
|
racket/provide-syntax
|
||||||
"../base/main.rkt"
|
"../base/main.rkt"
|
||||||
(submod alexis/util/struct get-struct-accessors)
|
(submod alexis/util/struct get-struct-accessors)
|
||||||
(for-syntax racket/base
|
(for-syntax racket/base
|
||||||
|
@ -15,7 +16,9 @@
|
||||||
"../test-util/test-lens.rkt"))
|
"../test-util/test-lens.rkt"))
|
||||||
|
|
||||||
(provide define-struct-lenses
|
(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)
|
(define-for-syntax (get-struct-field-ids struct-info failure-context)
|
||||||
|
@ -55,6 +58,18 @@
|
||||||
(struct s (field-spec ...) option ...)
|
(struct s (field-spec ...) option ...)
|
||||||
(define-struct-lenses s)))
|
(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
|
(module+ test
|
||||||
(struct/lens foo (a b c d) #:transparent)
|
(struct/lens foo (a b c d) #:transparent)
|
||||||
(check-lens-view foo-b-lens (foo 1 2 3 4) 2)
|
(check-lens-view foo-b-lens (foo 1 2 3 4) 2)
|
||||||
|
|
|
@ -13,6 +13,7 @@
|
||||||
"string-split.rkt"
|
"string-split.rkt"
|
||||||
"struct-join.rkt"
|
"struct-join.rkt"
|
||||||
"struct-nested.rkt"
|
"struct-nested.rkt"
|
||||||
|
"struct-provide.rkt"
|
||||||
"sublist.rkt"
|
"sublist.rkt"
|
||||||
"syntax.rkt"
|
"syntax.rkt"
|
||||||
"view-set.rkt"
|
"view-set.rkt"
|
||||||
|
|
|
@ -26,6 +26,7 @@ this library being backwards-compatible.
|
||||||
"string-split.scrbl"
|
"string-split.scrbl"
|
||||||
"struct-join.scrbl"
|
"struct-join.scrbl"
|
||||||
"struct-nested.scrbl"
|
"struct-nested.scrbl"
|
||||||
|
"struct-provide.scrbl"
|
||||||
"sublist.scrbl"
|
"sublist.scrbl"
|
||||||
"syntax.scrbl"
|
"syntax.scrbl"
|
||||||
"view-set.scrbl"
|
"view-set.scrbl"
|
||||||
|
|
4
unstable/lens/struct-provide.rkt
Normal file
4
unstable/lens/struct-provide.rkt
Normal file
|
@ -0,0 +1,4 @@
|
||||||
|
#lang sweet-exp reprovide
|
||||||
|
only-in lens/private/struct/struct
|
||||||
|
struct-lenses-out
|
||||||
|
struct+lenses-out
|
17
unstable/lens/struct-provide.scrbl
Normal file
17
unstable/lens/struct-provide.scrbl
Normal file
|
@ -0,0 +1,17 @@
|
||||||
|
#lang scribble/manual
|
||||||
|
|
||||||
|
@(require lens/private/doc-util/main)
|
||||||
|
|
||||||
|
@title{Struct-lens provide forms}
|
||||||
|
|
||||||
|
@defmodule[unstable/lens/struct-provide]
|
||||||
|
|
||||||
|
@defform[(struct-lenses-out struct-id)]{
|
||||||
|
A @racket[provide] sub-form that provides the lenses defined by
|
||||||
|
@racket[define-struct-lenses] or @racket[struct/lens].
|
||||||
|
}
|
||||||
|
|
||||||
|
@defform[(struct+lenses-out struct-id)]{
|
||||||
|
A @racket[provide] sub-form short for using both @racket[struct-out] and
|
||||||
|
@racket[struct-lenses-out].
|
||||||
|
}
|
Loading…
Reference in New Issue
Block a user