From 9e365017043e9090e2824f9adb9a10d1c7ca0246 Mon Sep 17 00:00:00 2001 From: AlexKnauth Date: Sat, 5 Dec 2015 02:13:19 -0500 Subject: [PATCH 1/3] add struct->list-lens and list->struct-lens --- unstable/lens/struct-list.rkt | 59 +++++++++++++++++++++++++++++++++++ 1 file changed, 59 insertions(+) create mode 100644 unstable/lens/struct-list.rkt diff --git a/unstable/lens/struct-list.rkt b/unstable/lens/struct-list.rkt new file mode 100644 index 0000000..75329c9 --- /dev/null +++ b/unstable/lens/struct-list.rkt @@ -0,0 +1,59 @@ +#lang sweet-exp racket/base + +provide struct->list-lens list->struct-lens + +require racket/local + unstable/lens/isomorphism/base + for-syntax racket/base + racket/list + racket/struct-info + syntax/parse +module+ test + require lens/private/base/base + lens/private/test-util/test-lens + rackunit + +begin-for-syntax + (define-syntax-class struct-id + #:attributes (info constructor-id [accessor-id 1]) + [pattern struct-id:id + #:attr v (syntax-local-value #'struct-id (λ () #f)) + #:when (struct-info? (attribute v)) + #:attr info (extract-struct-info (attribute v)) + #:with descriptor-id:id (first (attribute info)) + #:with constructor-id:id (syntax-property (second (attribute info)) + 'disappeared-use + (list (syntax-local-introduce #'struct-id))) + #:with predicate-id:id (third (attribute info)) + #:with [accessor-id:id ...] (reverse (fourth (attribute info)))]) + +(define-syntax struct->list-lens + (syntax-parser + [(struct->list-lens s:struct-id) + #'(local [(define (struct->list struct) + (list (s.accessor-id struct) ...)) + (define (list->struct list) + (apply s.constructor-id list))] + (make-isomorphism-lens struct->list list->struct))])) + +(define-syntax list->struct-lens + (syntax-parser + [(list->struct-lens s:struct-id) + #'(isomorphism-lens-inverse (struct->list-lens s))])) + +module+ test + (struct foo (a b c)) + ;; foo is opaque, so struct->vector doesn't work + (check-equal? (struct->vector (foo 1 2 3)) '#(struct:foo ...)) + (test-case "without inheritance" + (check-equal? (lens-view (struct->list-lens foo) (foo 1 2 3)) '(1 2 3)) + (check-match (lens-set (struct->list-lens foo) (foo 1 2 3) '(4 5 6)) (foo 4 5 6)) + (check-match (lens-view (list->struct-lens foo) '(1 2 3)) (foo 1 2 3)) + (check-equal? (lens-set (list->struct-lens foo) '(1 2 3) (foo 4 5 6)) '(4 5 6))) + (struct bar foo (d e)) + (test-case "inheriting from foo" + (check-equal? (lens-view (struct->list-lens bar) (bar 1 2 3 4 5)) '(1 2 3 4 5)) + (check-match (lens-set (struct->list-lens bar) (bar 1 2 3 4 5) '(6 7 8 9 10)) (bar 6 7 8 9 10)) + (check-match (lens-view (list->struct-lens bar) '(1 2 3 4 5)) (bar 1 2 3 4 5)) + (check-equal? (lens-set (list->struct-lens bar) '(1 2 3 4 4) (bar 6 7 8 9 10)) '(6 7 8 9 10))) + From 3450c2412706e0f27a358125992290d5eb372639 Mon Sep 17 00:00:00 2001 From: AlexKnauth Date: Sat, 5 Dec 2015 12:01:38 -0500 Subject: [PATCH 2/3] provide and document struct->list and list->struct lenses --- unstable/lens/main.rkt | 1 + unstable/lens/main.scrbl | 1 + unstable/lens/struct-list.scrbl | 23 +++++++++++++++++++++++ 3 files changed, 25 insertions(+) create mode 100644 unstable/lens/struct-list.scrbl diff --git a/unstable/lens/main.rkt b/unstable/lens/main.rkt index 9c8fa8e..8163511 100644 --- a/unstable/lens/main.rkt +++ b/unstable/lens/main.rkt @@ -13,6 +13,7 @@ "set-member.rkt" "string-split.rkt" "struct-join.rkt" +"struct-list.rkt" "struct-nested.rkt" "struct-provide.rkt" "sublist.rkt" diff --git a/unstable/lens/main.scrbl b/unstable/lens/main.scrbl index 0fa88ee..321fa3d 100644 --- a/unstable/lens/main.scrbl +++ b/unstable/lens/main.scrbl @@ -26,6 +26,7 @@ this library being backwards-compatible. "set-member.scrbl" "string-split.scrbl" "struct-join.scrbl" + "struct-list.scrbl" "struct-nested.scrbl" "struct-provide.scrbl" "sublist.scrbl" diff --git a/unstable/lens/struct-list.scrbl b/unstable/lens/struct-list.scrbl new file mode 100644 index 0000000..690a8c8 --- /dev/null +++ b/unstable/lens/struct-list.scrbl @@ -0,0 +1,23 @@ +#lang scribble/manual + +@(require lens/private/doc-util/main) + +@title{Converting between structs and lists} + +@deftogether[[ + @defform[(struct->list-lens struct-id)] + @defform[(list->struct-lens struct-id)]]]{ +Lenses that convert between structs and lists. + +@lens-unstable-examples[ + (struct foo (a b c) #:transparent) + (lens-view (struct->list-lens foo) (foo 1 2 3)) + (lens-set (struct->list-lens foo) (foo 1 2 3) '(4 5 6)) + (lens-view (list->struct-lens foo) '(1 2 3)) + (lens-set (list->struct-lens foo) '(1 2 3) (foo 4 5 6)) + (struct bar foo (d e)) + (lens-view (struct->list-lens bar) (bar 1 2 3 4 5)) + (lens-set (struct->list-lens bar) (bar 1 2 3 4 5) '(6 7 8 9 10)) + (lens-view (list->struct-lens bar) '(1 2 3 4 5)) + (lens-set (list->struct-lens bar) '(1 2 3 4 4) (bar 6 7 8 9 10)) +]} From 00485b16dff3fa1321a292cfaeeb506725753f27 Mon Sep 17 00:00:00 2001 From: AlexKnauth Date: Sat, 5 Dec 2015 14:45:01 -0500 Subject: [PATCH 3/3] add explanation for structs with inheritance --- unstable/lens/struct-list.scrbl | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/unstable/lens/struct-list.scrbl b/unstable/lens/struct-list.scrbl index 690a8c8..6020f4e 100644 --- a/unstable/lens/struct-list.scrbl +++ b/unstable/lens/struct-list.scrbl @@ -15,6 +15,13 @@ Lenses that convert between structs and lists. (lens-set (struct->list-lens foo) (foo 1 2 3) '(4 5 6)) (lens-view (list->struct-lens foo) '(1 2 3)) (lens-set (list->struct-lens foo) '(1 2 3) (foo 4 5 6)) +] + +For structs that inherit from other structs, it puts the inherited +fields first, so that it matches the arguments to the constructor: + +@lens-unstable-examples[ + (struct foo (a b c) #:transparent) (struct bar foo (d e)) (lens-view (struct->list-lens bar) (bar 1 2 3 4 5)) (lens-set (struct->list-lens bar) (bar 1 2 3 4 5) '(6 7 8 9 10))