suzanne.soy/lens
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source 
Add struct-nested-lens
This commit is contained in:
Jack Firth 2015-08-21 11:07:01 -07:00
commit b78895ea04
5 changed files with 133 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
lens/doc-util/lenses-examples.rkt
View File

@ -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)

2
unstable/lens/main.rkt
View File

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

1
unstable/lens/main.scrbl
View File

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

49
unstable/lens/struct-nested.rkt Normal file
View File

@ -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)))

63
unstable/lens/struct-nested.scrbl Normal file
View File

@ -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)
]}