From 42215981e8ea498e7e4da3d8628ab1bae4a63bf7 Mon Sep 17 00:00:00 2001 From: AlexKnauth Date: Sat, 23 May 2015 12:37:14 -0400 Subject: [PATCH 1/5] update .gitignore --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index c21a092..2b187ab 100644 --- a/.gitignore +++ b/.gitignore @@ -3,3 +3,4 @@ **/*.html **/*.css **/*.js +*~ From 6281c2787994d944ebba6c1477fa1f5e6c2aa8c0 Mon Sep 17 00:00:00 2001 From: AlexKnauth Date: Sat, 23 May 2015 13:10:22 -0400 Subject: [PATCH 2/5] allow lens structs --- lenses/core.rkt | 51 +++++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 43 insertions(+), 8 deletions(-) diff --git a/lenses/core.rkt b/lenses/core.rkt index d930350..fbe7c1f 100644 --- a/lenses/core.rkt +++ b/lenses/core.rkt @@ -1,6 +1,6 @@ #lang racket -(require fancy-app) +(require fancy-app unstable/contract) (provide lens/c make-lens @@ -8,26 +8,55 @@ lens-view lens-set lens-transform - lens-compose) + lens-compose + lens-struct + lens-proc + ) (module+ test (require rackunit)) -(define (lens/c input subcomponent) +(define (lens-proc/c input subcomponent) (-> input (values subcomponent (-> subcomponent input)))) +(define lens-2-val-context-key + (make-continuation-mark-key 'lens-2-val-context-key)) + +(define-syntax-rule (let/immediate-mark key-expr val-id body-expr ...) + (call-with-immediate-continuation-mark key-expr (lambda (val-id) body-expr ...))) + +(struct lens-struct (proc) + #:property prop:procedure + (lambda (this target) + (let/immediate-mark lens-2-val-context-key lens-2-val-context? + (if lens-2-val-context? + ((lens-struct-proc this) target) + (lens-view (lens-struct-proc this) target))))) + +(define (lens-proc lns) + (match lns + [(lens-struct proc) proc] + [(? procedure? proc) proc])) + +(define (lens/c target/c view/c) + (define proc/c (lens-proc/c target/c view/c)) + (if/c lens-struct? + (struct/c lens-struct proc/c) + proc/c)) + (module+ test - (define list-lens (lens/c list? any/c)) - (check-pred chaperone-contract? list-lens)) + (define list-lens/c (lens/c list? any/c)) + (check-true (contract? list-lens/c)) + (check-false (flat-contract? list-lens/c))) (define ((make-lens getter setter) v) (values (getter v) - (setter v _))) + (setter v _))) ; fancy-app (module+ test (define (set-first l v) @@ -35,11 +64,17 @@ (define test-list '(1 2 3)) (define first-lens (make-lens first set-first)) (check-equal? (lens-view first-lens test-list) 1) - (check-equal? (lens-set first-lens test-list 'a) '(a 2 3))) + (check-equal? (lens-set first-lens test-list 'a) '(a 2 3)) + (define first* (lens-struct first-lens)) + (check-equal? (first* test-list) 1) + (check-equal? (lens-view first* test-list) 1) + (check-equal? (lens-set first* test-list 'a) '(a 2 3)) + ) (define-syntax-rule (let-lens (view setter) lens-call-expr body ...) - (let-values ([(view setter) lens-call-expr]) + (let-values ([(view setter) (with-continuation-mark lens-2-val-context-key #t + lens-call-expr)]) body ...)) (module+ test From a81269848b19044ab1551076e6069453a8d3881f Mon Sep 17 00:00:00 2001 From: AlexKnauth Date: Sat, 23 May 2015 13:17:43 -0400 Subject: [PATCH 3/5] add identity-lens and 0-arg (lens-compose) --- lenses/core.rkt | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/lenses/core.rkt b/lenses/core.rkt index fbe7c1f..fd4199f 100644 --- a/lenses/core.rkt +++ b/lenses/core.rkt @@ -9,6 +9,7 @@ lens-set lens-transform lens-compose + identity-lens lens-struct lens-proc ) @@ -58,6 +59,9 @@ (values (getter v) (setter v _))) ; fancy-app +(define identity-lens + (values _ identity)) ; fancy-app + (module+ test (define (set-first l v) (list* v (rest l))) @@ -65,6 +69,9 @@ (define first-lens (make-lens first set-first)) (check-equal? (lens-view first-lens test-list) 1) (check-equal? (lens-set first-lens test-list 'a) '(a 2 3)) + (check-equal? (lens-view identity-lens 3) 3) + (check-equal? (lens-set identity-lens 3 4) 4) + (check-equal? (lens-compose) identity-lens) (define first* (lens-struct first-lens)) (check-equal? (first* test-list) 1) (check-equal? (lens-view first* test-list) 1) @@ -114,7 +121,7 @@ (define (second-set l v) (list* (first l) v (rest (rest l)))) (define second-lens (make-lens second second-set)) - (define first-of-second-lens (lens-compose2 first-lens second-lens)) + (define first-of-second-lens (lens-compose first-lens second-lens)) (define test-alist '((a 1) (b 2) (c 3))) (check-eq? (lens-view first-of-second-lens test-alist) 'b) (check-equal? (lens-set first-of-second-lens test-alist 'B) @@ -134,4 +141,11 @@ (check-eqv? (num-append 1) 1)) -(define lens-compose (generalize-operator lens-compose2)) +(define lens-compose-proc (generalize-operator lens-compose2)) + +(define lens-compose + (case-lambda + [() identity-lens] + [(v . vs) + (apply lens-compose-proc v vs)])) + From aa8d896c8df670e744b64e74603c0d25b45a377d Mon Sep 17 00:00:00 2001 From: AlexKnauth Date: Sat, 23 May 2015 13:45:33 -0400 Subject: [PATCH 4/5] update docs --- lenses/lenses.scrbl | 49 ++++++++++++++++++++++++++++++++++++--------- 1 file changed, 39 insertions(+), 10 deletions(-) diff --git a/lenses/lenses.scrbl b/lenses/lenses.scrbl index c131ad7..9fc9525 100644 --- a/lenses/lenses.scrbl +++ b/lenses/lenses.scrbl @@ -27,7 +27,8 @@ source code: @url["https://github.com/jackfirth/lenses"] @section{Core Lens Forms} @defproc[(lens/c [target/c contract?] [view/c contract?]) contract?]{ - Contract constructor for lenses. A lens is a function that takes one + Contract constructor for lenses. A lens is either a function or + @racket[lens-struct] containing that function. The function takes one value, its @italic{target}, and returns two values, a @italic{view} and a @italic{context}. The context is a function that takes a new view value and "replaces" the old view value with the new value, giving a @@ -35,8 +36,8 @@ source code: @url["https://github.com/jackfirth/lenses"] specific piece of a @racket[target/c] that is a @racket[view/c], along with a way to replace that piece with a new view value. Lenses deconstruct and reconstruct data by examinimg small portions of their - structure. In terms of contracts, a @racket[(lens/c target/c view/c)] - is equivalent to the following function contract: + structure. In terms of contracts, @racket[(lens/c target/c view/c)] + checks the function with following function contract: @racketblock[ (-> target/c (values view/c @@ -46,10 +47,23 @@ source code: @url["https://github.com/jackfirth/lenses"] An example is the @racket[first-lens], which is a lens for examiniming specifically the first item in a list: @lenses-examples[ - (first-lens '(1 2 3)) - (let-values ([(_ context) (first-lens '(1 2 3))]) + (define first-lens-proc (lens-proc first-lens)) + (first-lens-proc '(1 2 3)) + (let-values ([(_ context) (first-lens-proc '(1 2 3))]) (context 'a)) -]} + (let-lens (_ context) (first-lens '(1 2 3)) + (context 'a)) + ] + + Lenses that are instances of the lens struct can also be used directly + as getter procedures: + @lenses-examples[ + (define first-lens* (lens-struct first-lens)) + (first-lens* '(1 2 3)) + (let-lens (fst context) (first-lens* '(1 2 3)) + (values fst (context 'a))) + ] +} @defproc[(make-lens [getter (-> target/c view/c)] [setter (-> target/c view/c target/c)]) @@ -66,9 +80,8 @@ source code: @url["https://github.com/jackfirth/lenses"] ]} @defform[(let-lens (view-id context-id) lens-call-expr body ...)]{ - Restricted form of @racket[let-values] specifically for working with - the return values of a lens function. This is purely for semantic - clarity and to eliminate a few extra parens. + Gets the two return values of a lens function and binds them to the + given identifiers within the body expressions. @lenses-examples[ (let-lens (view context) (first-lens '(1 2 3)) (printf "View is ~a\n" view) @@ -105,7 +118,7 @@ source code: @url["https://github.com/jackfirth/lenses"] (lens-transform first-lens number->string '(1 2 3)) ]} -@defproc[(lens-compose [lens proc] ...+) proc?]{ +@defproc[(lens-compose [lens proc] ...) lens?]{ Composes the given lenses together into one @italic{compound lens}. The compound lens operates similarly to composed functions do in that the last @racket[lens] is the first @racket[lens] the compound @@ -117,6 +130,10 @@ source code: @url["https://github.com/jackfirth/lenses"] (lens-set first-of-second-lens '((1 a) (2 b) (3 c)) 200) ]} +@defthing[identity-lens (lens/c any/c any/c)]{ +The identity lens. +} + @section{List lenses} @defproc[(list-lens [n exact-nonnegative-integer?]) @@ -222,3 +239,15 @@ source code: @url["https://github.com/jackfirth/lenses"] (lens-set foo-kw-seq-lens #'(a #:foo #:bar f) #'(1 2 3 4 5 6)) (lens-set foo-kw-seq-lens #'(a b f g) #'(these are ignored)) ]} + +@section{Lens Structs} + +@defproc[(lens-struct [proc procedure?]) lens-struct?]{ +Wraps a lens function in the lens struct. The result lens can also be +used directly as a getter procedure. +} + +@defproc[(lens-proc [lens lens?]) procedure?]{ +Gets a lens function. If @racket[lens] is a lens function but not a lens +struct, returns the @racket[lens]. +} From c837f1da5e9ad6c0a22efb5545615319434f68be Mon Sep 17 00:00:00 2001 From: AlexKnauth Date: Wed, 24 Jun 2015 17:59:38 -0400 Subject: [PATCH 5/5] add lenses/applicable --- lenses/applicable.rkt | 42 ++++++++++++++++++++++++++++++++++++++++++ lenses/lenses.scrbl | 9 +++++++++ 2 files changed, 51 insertions(+) create mode 100644 lenses/applicable.rkt diff --git a/lenses/applicable.rkt b/lenses/applicable.rkt new file mode 100644 index 0000000..fcf8377 --- /dev/null +++ b/lenses/applicable.rkt @@ -0,0 +1,42 @@ +#lang racket/base + +(provide (all-defined-out) + lens/c let-lens lens-view lens-set lens-transform lens-struct lens-proc) + +(require (prefix-in - "main.rkt") + (only-in "main.rkt" + lens/c let-lens lens-view lens-set lens-transform lens-struct lens-proc)) + +(define (make-lens getter setter) + (lens-struct (-make-lens getter setter))) + +(define (lens-compose . args) + (lens-struct (apply -lens-compose args))) + +(define identity-lens + (lens-struct -identity-lens)) + +(define (list-lens n) + (lens-struct (-list-lens n))) + +(define first-lens (lens-struct -first-lens)) +(define second-lens (lens-struct -second-lens)) +(define third-lens (lens-struct -third-lens)) +(define fourth-lens (lens-struct -fourth-lens)) +(define fifth-lens (lens-struct -fifth-lens)) + +(define (assoc-lens key #:is-equal? [key-equal? equal?]) + (lens-struct (-assoc-lens key #:is-equal? key-equal?))) + +(define (assv-lens key) + (lens-struct (-assv-lens key))) + +(define (assq-lens key) + (lens-struct (-assq-lens key))) + +(define-syntax-rule (syntax-lens target-id pattern) + (lens-struct (-syntax-lens target-id pattern))) + +(define-syntax-rule (syntax-keyword-seq-lens kw) + (lens-struct (-syntax-keyword-seq-lens kw))) + diff --git a/lenses/lenses.scrbl b/lenses/lenses.scrbl index 9fc9525..4c2d7b7 100644 --- a/lenses/lenses.scrbl +++ b/lenses/lenses.scrbl @@ -251,3 +251,12 @@ used directly as a getter procedure. Gets a lens function. If @racket[lens] is a lens function but not a lens struct, returns the @racket[lens]. } + +@section{lenses/applicable} + +@defmodule[lenses/applicable] + +This module provides the same functions as @racketmodname[lenses], but lenses +are provided as applicable lens structs, and functions that return lenses return +lens structs. +