Merge pull request #164 from jackfirth/feature-struct-nested

Add struct-nested-lens

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)

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"

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"]

unstable/lens/struct-nested.rkt

@@ -0,0 +1,49 @@
+#lang racket/base
+
+(require fancy-app
+         lens
+         (for-syntax racket/base
+                     syntax/parse))
+
+(module+ test
+  (require rackunit))
+
+(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 both0:id both:id ... field-id:id)
+     #'(lens-thrush (struct-lens struct-id both0)
+                    (struct-nested-lens* both0 both ... field-id))]))
+
+(module+ test
+  (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)))
+
+ 

unstable/lens/struct-nested.scrbl

@@ -0,0 +1,63 @@
+#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 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[
+    (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.
+  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]
+                          [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 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)
+    (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 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[
+    (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)
+]}