diff --git a/unstable/lens/main.rkt b/unstable/lens/main.rkt index 93a61f5..e4eb6d0 100644 --- a/unstable/lens/main.rkt +++ b/unstable/lens/main.rkt @@ -9,6 +9,7 @@ "struct.rkt" "arrow.rkt" "hash-pluck.rkt" + "stream.rkt" ) (provide (all-from-out "syntax.rkt" @@ -20,4 +21,5 @@ "struct.rkt" "arrow.rkt" "hash-pluck.rkt" + "stream.rkt" )) diff --git a/unstable/lens/main.scrbl b/unstable/lens/main.scrbl index 2800730..e4b25e6 100644 --- a/unstable/lens/main.scrbl +++ b/unstable/lens/main.scrbl @@ -18,3 +18,4 @@ this library being backwards-compatible. @include-section["struct.scrbl"] @include-section["arrow.scrbl"] @include-section["hash-pluck.scrbl"] +@include-section["stream.scrbl"] diff --git a/unstable/lens/stream.rkt b/unstable/lens/stream.rkt new file mode 100644 index 0000000..2894c05 --- /dev/null +++ b/unstable/lens/stream.rkt @@ -0,0 +1,56 @@ +#lang racket/base + +(provide stream-first-lens + stream-rest-lens + stream-ref-lens + ) + +(require racket/stream + fancy-app + lens/base/main + ) +(module+ test + (require rackunit lens/test-util/test-lens)) + +(define (stream-ref-lens i) + (lens-compose stream-first-lens (stream-tail-lens i))) + +(define (stream-set-first s v) + (stream-cons v (stream-rest s))) + +(define (stream-set-rest s rst) + (stream-cons (stream-first s) rst)) + +(define stream-first-lens + (make-lens + stream-first + stream-set-first)) + +(define stream-rest-lens + (make-lens + stream-rest + stream-set-rest)) + +(define (stream-tail-lens i) + (make-lens + (stream-tail _ i) + (stream-set-tail _ i _))) + +(define (stream-set-tail s i rst) + (define rev-fst + (for/fold ([rev-fst '()]) ([v (in-stream s)] [_ (in-range i)]) + (cons v rev-fst))) + (for/fold ([rst rst]) ([v (in-list rev-fst)]) + (stream-cons v rst))) + +(define (stream-ref-nested-lens . is) + (apply lens-thrush (map stream-ref-lens is))) + +(module+ test + (check-view stream-first-lens (stream 'a 'b 'c) 'a) + (check-view (stream-ref-lens 2) (stream 'a 'b 'c) 'c) + (check-set-view stream-first-lens (stream 'a 'b 'c) (gensym)) + (check-set-view (stream-ref-lens 2) (stream 'a 'b 'c) (gensym)) + (check-set-set stream-first-lens (stream 'a 'b 'c) (gensym) (gensym)) + (check-set-set (stream-ref-lens 2) (stream 'a 'b 'c) (gensym) (gensym)) + ) diff --git a/unstable/lens/stream.scrbl b/unstable/lens/stream.scrbl new file mode 100644 index 0000000..3a7b17b --- /dev/null +++ b/unstable/lens/stream.scrbl @@ -0,0 +1,27 @@ +#lang scribble/manual + +@(require lens/doc-util/main) + +@title{Stream Lenses} + +@defthing[stream-first-lens lens?]{ +A lens for viewing the first element of a stream. +@lenses-unstable-examples[ + (lens-view stream-first-lens (stream 1 2 3)) + (stream->list (lens-set stream-first-lens (stream 1 2 3) 'a)) +]} + +@defthing[stream-rest-lens lens?]{ +A lens for viewing the rest of a stream after the first element. +@lenses-unstable-examples[ + (stream->list (lens-view stream-rest-lens (stream 1 2 3))) + (stream->list (lens-set stream-rest-lens (stream 1 2 3) (stream 200 300 400 500))) +]} + +@defproc[(stream-ref-lens [i exact-nonnegative-integer?]) lens?]{ +A lens for viewing the @racket[i]th element of a stream. +@lenses-unstable-examples[ + (lens-view (stream-ref-lens 2) (stream 1 2 3 4 5 6)) + (stream->list (lens-set (stream-ref-lens 2) (stream 1 2 3 4 5 6) 'a)) +]} +