add stream stuff

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

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

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

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