From 5a10edb1f31bba258be8e2fd326041cc75def641 Mon Sep 17 00:00:00 2001 From: Jack Firth Date: Thu, 20 Aug 2015 18:04:42 -0700 Subject: [PATCH 1/4] Add struct-nested-lens --- lens/doc-util/lenses-examples.rkt | 20 +++++++++++-- unstable/lens/main.rkt | 2 ++ unstable/lens/main.scrbl | 1 + unstable/lens/struct-nested.rkt | 34 +++++++++++++++++++++ unstable/lens/struct-nested.scrbl | 50 +++++++++++++++++++++++++++++++ 5 files changed, 105 insertions(+), 2 deletions(-) create mode 100644 unstable/lens/struct-nested.rkt create mode 100644 unstable/lens/struct-nested.scrbl diff --git a/lens/doc-util/lenses-examples.rkt b/lens/doc-util/lenses-examples.rkt index fc9aed5..f874920 100644 --- a/lens/doc-util/lenses-examples.rkt +++ b/lens/doc-util/lenses-examples.rkt @@ -2,9 +2,11 @@ (provide lenses-examples lenses-applicable-examples - lenses-unstable-examples) + lenses-unstable-examples + define-persistant-lenses-unstable-examples) -(require scribble/eval) +(require scribble/eval + racket/splicing) (define-syntax-rule (define-examples-form id require-spec ...) @@ -16,6 +18,17 @@ (define-syntax-rule (id datum (... ...)) (examples #:eval (eval-factory) datum (... ...))))) +(define-syntax-rule (define-examples/persistance-syntax id require-spec ...) + (begin + (define (eval-factory) + (define base-eval (make-base-eval)) + (base-eval '(require require-spec)) ... + base-eval) + (define-syntax-rule (id examples-id) + (begin + (splicing-let ([the-eval (eval-factory)]) + (define-syntax-rule (examples-id datum (... (... ...))) + (examples #:eval the-eval datum (... (... ...))))))))) (define-examples-form lenses-examples lens racket/list racket/vector racket/stream) @@ -25,3 +38,6 @@ (define-examples-form lenses-unstable-examples lens unstable/lens racket/list racket/vector racket/stream) + +(define-examples/persistance-syntax define-persistant-lenses-unstable-examples + lens unstable/lens racket/list racket/vector racket/stream) diff --git a/unstable/lens/main.rkt b/unstable/lens/main.rkt index 76dc064..84babb1 100644 --- a/unstable/lens/main.rkt +++ b/unstable/lens/main.rkt @@ -2,6 +2,7 @@ (require "syntax.rkt" "view-set.rkt" + "struct-nested.rkt" "sublist.rkt" "arrow.rkt" "isomorphism.rkt" @@ -12,6 +13,7 @@ (provide (all-from-out "syntax.rkt" "view-set.rkt" + "struct-nested.rkt" "sublist.rkt" "arrow.rkt" "isomorphism.rkt" diff --git a/unstable/lens/main.scrbl b/unstable/lens/main.scrbl index 8855265..deb9a6c 100644 --- a/unstable/lens/main.scrbl +++ b/unstable/lens/main.scrbl @@ -11,6 +11,7 @@ this library being backwards-compatible. @include-section["view-set.scrbl"] @include-section["syntax.scrbl"] +@include-section["struct-nested.scrbl"] @include-section["sublist.scrbl"] @include-section["arrow.scrbl"] @include-section["isomorphism.scrbl"] diff --git a/unstable/lens/struct-nested.rkt b/unstable/lens/struct-nested.rkt new file mode 100644 index 0000000..ad78dec --- /dev/null +++ b/unstable/lens/struct-nested.rkt @@ -0,0 +1,34 @@ +#lang racket/base + +(require fancy-app + lens + (for-syntax racket/base + syntax/parse)) + +(module+ test + (require rackunit)) + +(provide struct-nested-lens) + + +(define-syntax struct-nested-lens + (syntax-parser + [(_ struct-id:id field-id:id) + #'(struct-lens struct-id field-id)] + [(_ struct-id:id [field-id:id field-struct-id:id] rest ...) + #'(lens-thrush (struct-lens struct-id field-id) + (struct-nested-lens field-struct-id rest ...))] + [(_ struct-id:id field-and-field-struct-id:id rest ...) + #'(struct-nested-lens struct-id + [field-and-field-struct-id field-and-field-struct-id] + rest ...)])) + +(module+ test + (struct a (b b2) #:prefab) + (struct b (b1 b2 b3) #:prefab) + (define a-b-b1-lens (struct-nested-lens a b b1)) + (define a-b2-b3-lens (struct-nested-lens a [b2 b] b3)) + (check-equal? (lens-view a-b-b1-lens (a (b 1 2 3) 'foo)) 1) + (check-equal? (lens-set a-b-b1-lens (a (b 1 2 3) 'foo) 10) (a (b 10 2 3) 'foo)) + (check-equal? (lens-view a-b2-b3-lens (a 'foo (b 1 2 3))) 3) + (check-equal? (lens-set a-b2-b3-lens (a 'foo (b 1 2 3)) 10) (a 'foo (b 1 2 10)))) diff --git a/unstable/lens/struct-nested.scrbl b/unstable/lens/struct-nested.scrbl new file mode 100644 index 0000000..51bdc7a --- /dev/null +++ b/unstable/lens/struct-nested.scrbl @@ -0,0 +1,50 @@ +#lang scribble/manual + +@(require lens/doc-util/main) + +@title{Nested struct lenses} + +@defmodule[unstable/lens/struct-nested] + +@(define-persistant-lenses-unstable-examples struct-nested-examples) + +@defform[#:id struct-nested-lens + (struct-nested-lens struct-id intermediate ... field-id) + #:grammar ([intermediate (code:line [subfield-id subfield-struct-id]) both-id])]{ + Constructs a lens that views nested structures. The first @racket[struct-id] is the + outermost struct type, the last @racket[field-id] is the innermost target field. Each + @racket[intermediate] specifies how to walk down one level of the nested structs, and + is either a pair of a @racket[subfield-id] and that field's struct type in + @racket[subfield-struct-id], or a single @racket[both-id] in the common case that the + field name is the same as the struct name. + + For example, given a complicated nested tree of state representing a game: + @struct-nested-examples[ + (struct game (player level) #:transparent) + (struct player (posn stats) #:transparent) + (struct posn (x y) #:transparent) + (struct combat-stats (health attack) #:transparent) + (define the-game (game (player (posn 0 0) (combat-stats 10 1)) 'foo-level)) + the-game + ] + + We can create a lens for traversing the nested structures of the game state. + This takes advantage of the fact that each struct's fields are the same name + as the struct that that field is a value of. + @struct-nested-examples[ + (define game-player-posn-x-lens + (struct-nested-lens game player posn x)) + (lens-view game-player-posn-x-lens the-game) + (lens-set game-player-posn-x-lens the-game 3) + ] + + In the case of the player's combat stats, the field is @italic{not} the + same name as the @racket[combat-stats] struct. Therefore, we use the + more verbose @racket[[subfield-id subfield-struct-id]] form for that + step of the nested struct traversal. + @struct-nested-examples[ + (define game-player-health-lens + (struct-nested-lens game player [stats combat-stats] health)) + (lens-view game-player-health-lens the-game) + (lens-set game-player-health-lens the-game 20) +]} From 4965d54fa3b10e5eb731da3d941798b3f5053e3c Mon Sep 17 00:00:00 2001 From: Jack Firth Date: Thu, 20 Aug 2015 22:12:57 -0700 Subject: [PATCH 2/4] Split shorthand into separate macro, adjust docs --- unstable/lens/struct-nested.rkt | 47 ++++++++++++++++--------- unstable/lens/struct-nested.scrbl | 57 +++++++++++++++++++------------ 2 files changed, 66 insertions(+), 38 deletions(-) diff --git a/unstable/lens/struct-nested.rkt b/unstable/lens/struct-nested.rkt index ad78dec..ffd5f78 100644 --- a/unstable/lens/struct-nested.rkt +++ b/unstable/lens/struct-nested.rkt @@ -8,27 +8,42 @@ (module+ test (require rackunit)) -(provide struct-nested-lens) +(provide struct-nested-lens + struct-nested-lens*) (define-syntax struct-nested-lens + (syntax-parser + [(_ [struct-id:id field-id:id] ...) + #'(lens-thrush (struct-lens struct-id field-id) ...)])) + +(define-syntax struct-nested-lens* (syntax-parser [(_ struct-id:id field-id:id) #'(struct-lens struct-id field-id)] - [(_ struct-id:id [field-id:id field-struct-id:id] rest ...) - #'(lens-thrush (struct-lens struct-id field-id) - (struct-nested-lens field-struct-id rest ...))] - [(_ struct-id:id field-and-field-struct-id:id rest ...) - #'(struct-nested-lens struct-id - [field-and-field-struct-id field-and-field-struct-id] - rest ...)])) + [(_ struct-id:id both0:id both:id ... field-id:id) + #'(lens-thrush (struct-lens struct-id both0) + (struct-nested-lens* both0 both ... field-id))])) (module+ test - (struct a (b b2) #:prefab) - (struct b (b1 b2 b3) #:prefab) - (define a-b-b1-lens (struct-nested-lens a b b1)) - (define a-b2-b3-lens (struct-nested-lens a [b2 b] b3)) - (check-equal? (lens-view a-b-b1-lens (a (b 1 2 3) 'foo)) 1) - (check-equal? (lens-set a-b-b1-lens (a (b 1 2 3) 'foo) 10) (a (b 10 2 3) 'foo)) - (check-equal? (lens-view a-b2-b3-lens (a 'foo (b 1 2 3))) 3) - (check-equal? (lens-set a-b2-b3-lens (a 'foo (b 1 2 3)) 10) (a 'foo (b 1 2 10)))) + (struct game (player level) #:transparent) + (struct player (posn stats) #:transparent) + (struct posn (x y) #:transparent) + (struct combat-stats (health attack) #:transparent) + (define the-game (game (player (posn 0 0) (combat-stats 10 1)) 'foo-level)) + + (define game-player-health-lens + (struct-nested-lens [game player] + [player stats] + [combat-stats health])) + (check-equal? (lens-view game-player-health-lens the-game) 10) + (check-equal? (lens-set game-player-health-lens the-game 20) + (game (player (posn 0 0) (combat-stats 20 1)) 'foo-level)) + + (define game-player-posn-x-lens + (struct-nested-lens* game player posn x)) + (check-equal? (lens-view game-player-posn-x-lens the-game) 0) + (check-equal? (lens-set game-player-posn-x-lens the-game 3) + (game (player (posn 3 0) (combat-stats 10 1)) 'foo-level))) + + \ No newline at end of file diff --git a/unstable/lens/struct-nested.scrbl b/unstable/lens/struct-nested.scrbl index 51bdc7a..6110e58 100644 --- a/unstable/lens/struct-nested.scrbl +++ b/unstable/lens/struct-nested.scrbl @@ -9,14 +9,10 @@ @(define-persistant-lenses-unstable-examples struct-nested-examples) @defform[#:id struct-nested-lens - (struct-nested-lens struct-id intermediate ... field-id) - #:grammar ([intermediate (code:line [subfield-id subfield-struct-id]) both-id])]{ - Constructs a lens that views nested structures. The first @racket[struct-id] is the - outermost struct type, the last @racket[field-id] is the innermost target field. Each - @racket[intermediate] specifies how to walk down one level of the nested structs, and - is either a pair of a @racket[subfield-id] and that field's struct type in - @racket[subfield-struct-id], or a single @racket[both-id] in the common case that the - field name is the same as the struct name. + (struct-nested-lens [struct-id field-id] ...)]{ + Constructs a lens that views nested structures. Each @racket[struct-id] and + @racket[field-id] pair is paired into a lens for viewing that field of that + struct, then the list of lenses are @racket[lens-thrush]ed together. For example, given a complicated nested tree of state representing a game: @struct-nested-examples[ @@ -29,22 +25,39 @@ ] We can create a lens for traversing the nested structures of the game state. - This takes advantage of the fact that each struct's fields are the same name - as the struct that that field is a value of. - @struct-nested-examples[ - (define game-player-posn-x-lens - (struct-nested-lens game player posn x)) - (lens-view game-player-posn-x-lens the-game) - (lens-set game-player-posn-x-lens the-game 3) - ] - - In the case of the player's combat stats, the field is @italic{not} the - same name as the @racket[combat-stats] struct. Therefore, we use the - more verbose @racket[[subfield-id subfield-struct-id]] form for that - step of the nested struct traversal. + At each step, we provide the name of the struct we're examining and the name + of the field we wish to traverse into. @struct-nested-examples[ (define game-player-health-lens - (struct-nested-lens game player [stats combat-stats] health)) + (struct-nested-lens [game player] + [player stats] + [combat-stats health])) (lens-view game-player-health-lens the-game) (lens-set game-player-health-lens the-game 20) ]} + +@(define-persistant-lenses-unstable-examples struct-nested*-examples) + +@defform[#:id struct-nested-lens* + (struct-nested-lens* struct-id both-id ... field-id)]{ + Like @racket[struct-nested-lens], but for the case where each nested + field is named the same as it's struct type. For example, given the + game state defined in the examples for @racket[struct-nested-lens]: + @struct-nested*-examples[ + (struct game (player level) #:transparent) + (struct player (posn stats) #:transparent) + (struct posn (x y) #:transparent) + (struct combat-stats (health attack) #:transparent) + (define the-game (game (player (posn 0 0) (combat-stats 10 1)) 'foo-level)) + the-game + ] + + Because each field is named the same as it's struct type, we can + create a lens for viewing the player's x coordinate more succinctly + than with @racket[struct-nested-examples]: + @struct-nested*-examples[ + (define game-player-x-lens + (struct-nested-lens* game player posn x)) + (lens-view game-player-x-lens the-game) + (lens-set game-player-x-lens the-game 5) +]} From 14593de16aa1e7df796d78d9f94e19128082004d Mon Sep 17 00:00:00 2001 From: Jack Firth Date: Fri, 21 Aug 2015 10:31:21 -0700 Subject: [PATCH 3/4] Fix minor things --- lens/doc-util/scribble-include-no-subsection.rkt | 3 +-- unstable/lens/struct-nested.scrbl | 4 ++-- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/lens/doc-util/scribble-include-no-subsection.rkt b/lens/doc-util/scribble-include-no-subsection.rkt index 6161c15..189f078 100644 --- a/lens/doc-util/scribble-include-no-subsection.rkt +++ b/lens/doc-util/scribble-include-no-subsection.rkt @@ -6,8 +6,7 @@ racket/match scribble/core (for-syntax racket/base - syntax/parse - )) + syntax/parse)) ;; scribble-include/no-subsection requires that the module to be included: ;; - has no title diff --git a/unstable/lens/struct-nested.scrbl b/unstable/lens/struct-nested.scrbl index 6110e58..e7bc608 100644 --- a/unstable/lens/struct-nested.scrbl +++ b/unstable/lens/struct-nested.scrbl @@ -41,7 +41,7 @@ @defform[#:id struct-nested-lens* (struct-nested-lens* struct-id both-id ... field-id)]{ Like @racket[struct-nested-lens], but for the case where each nested - field is named the same as it's struct type. For example, given the + field is named the same as its struct type. For example, given the game state defined in the examples for @racket[struct-nested-lens]: @struct-nested*-examples[ (struct game (player level) #:transparent) @@ -52,7 +52,7 @@ the-game ] - Because each field is named the same as it's struct type, we can + Because each field is named the same as its struct type, we can create a lens for viewing the player's x coordinate more succinctly than with @racket[struct-nested-examples]: @struct-nested*-examples[ From e14cd8be651ec7d31e6b6802288beb28e6cfb93d Mon Sep 17 00:00:00 2001 From: Jack Firth Date: Fri, 21 Aug 2015 10:54:33 -0700 Subject: [PATCH 4/4] Revert paren change --- lens/doc-util/scribble-include-no-subsection.rkt | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lens/doc-util/scribble-include-no-subsection.rkt b/lens/doc-util/scribble-include-no-subsection.rkt index 189f078..6161c15 100644 --- a/lens/doc-util/scribble-include-no-subsection.rkt +++ b/lens/doc-util/scribble-include-no-subsection.rkt @@ -6,7 +6,8 @@ racket/match scribble/core (for-syntax racket/base - syntax/parse)) + syntax/parse + )) ;; scribble-include/no-subsection requires that the module to be included: ;; - has no title