more stream-seekable? and stream-length methods

- limited-streams and throw-on-eof-streams
- string-readers and byte-readers

basis/io/streams/limited/limited-tests.factor

@@ -122,3 +122,7 @@ IN: io.streams.limited.tests
         [ contents ] with-unlimited-input
     ] with-input-stream
 ] unit-test
+
+{ 4 } [ B{ 0 1 2 3 4 5 } binary <byte-reader> 4 <limited-stream> stream-length ] unit-test
+{ 6 } [ B{ 0 1 2 3 4 5 } binary <byte-reader> 8 <limited-stream> stream-length ] unit-test
+

basis/io/streams/limited/limited.factor

@@ -3,7 +3,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors byte-vectors combinators destructors fry io
 io.encodings io.files io.files.info kernel locals math
-namespaces sequences ;
+namespaces sequences math.order ;
 IN: io.streams.limited
 
 TUPLE: limited-stream stream count limit current start stop ;
@@ -22,7 +22,8 @@ TUPLE: limited-stream stream count limit current start stop ;
 GENERIC# limit-stream 1 ( stream limit -- stream' )
 
 M: decoder limit-stream ( stream limit -- stream' )
-    [ clone ] dip '[ _ limit-stream ] change-stream ;
+    '[ stream>> _ limit-stream ] [ code>> ] [ cr>> ] tri
+    decoder boa ; inline
 
 M: object limit-stream ( stream limit -- stream' )
     <limited-stream> ;
@@ -78,7 +79,8 @@ ERROR: limit-exceeded n stream ;
     pick 0 <= [ 3drop f ] [ [ stream>> ] dip call ] if ; inline
 
 :: maybe-read-unsafe ( n buf limited-stream quot: ( n buf stream -- count ) -- count )
-    n limited-stream [| n' stream | n' buf stream quot call ] maybe-read ; inline
+    n limited-stream adjust-limited-read :> ( n' lstream' )
+    n' 0 <= [ 0 ] [ n' buf lstream' stream>> quot call ] if ; inline
 
 PRIVATE>
 
@@ -130,6 +132,13 @@ M: limited-stream stream-seek
     [ stream>> stream-seek ]
     [ limited-stream-seek ] 3bi ;
 
+M: limited-stream stream-seekable?
+    stream>> stream-seekable? ; inline
+
+M: limited-stream stream-length
+    dup stream>> stream-length
+    [ swap limit>> min ] [ drop f ] if* ; inline
+
 M: limited-stream dispose stream>> dispose ;
 
 M: limited-stream stream-element-type
@@ -138,7 +147,7 @@ M: limited-stream stream-element-type
 GENERIC: unlimit-stream ( stream -- stream' )
 
 M: decoder unlimit-stream ( stream -- stream' )
-    [ stream>> ] change-stream ;
+    [ stream>> stream>> ] [ code>> ] [ cr>> ] tri decoder boa ;
 
 M: limited-stream unlimit-stream ( stream -- stream' ) stream>> ;
 

basis/io/streams/string/string.factor

@@ -15,6 +15,8 @@ M: string-reader stream-read1 sequence-read1 ;
 M: string-reader stream-read-until sequence-read-until ;
 M: string-reader stream-tell i>> ;
 M: string-reader stream-seek (stream-seek) ;
+M: string-reader stream-seekable? drop t ; inline
+M: string-reader stream-length underlying>> length ;
 M: string-reader dispose drop ;
 
 <PRIVATE

basis/io/streams/throwing/throwing-tests.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2010 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: io io.encodings.utf8 io.files io.streams.string
-io.streams.throwing kernel tools.test destructors ;
+USING: destructors io io.encodings.binary io.encodings.utf8
+io.files io.streams.byte-array io.streams.string
+io.streams.throwing kernel namespaces tools.test ;
 IN: io.streams.throwing.tests
 
 [ "asdf" ]
@@ -39,14 +40,16 @@ IN: io.streams.throwing.tests
     ] with-file-reader
 ] unit-test
 
-[ "asdf" "asdf" ] [
-    "asdf" [
+[ B{ 0 1 2 3 } B{ 0 1 2 3 } ] [
+    B{ 0 1 2 3 } binary [
         [ 4 read 0 seek-absolute seek-input 4 read ] throw-on-eof
-    ] with-string-reader
+    ] with-byte-reader
 ] unit-test
 
 [
-    "asdf" [ [ 1 seek-absolute seek-input 4 read drop ] throw-on-eof ] with-string-reader
+    B{ 0 1 2 3 } binary [
+        [ 1 seek-absolute seek-input 4 read drop ] throw-on-eof
+    ] with-byte-reader
 ] [ stream-exhausted? ] must-fail-with
 
 [ "asd" CHAR: f ] [
@@ -57,6 +60,14 @@ IN: io.streams.throwing.tests
     "asdf" [ [ "g" read-until ] throw-on-eof ] with-string-reader
 ] [ stream-exhausted? ] must-fail-with
 
-[ 1 ] [
-    "asdf" [ [ 1 seek-absolute seek-input tell-input ] throw-on-eof ] with-string-reader
+{ 1 } [
+    B{ 0 1 2 3 } binary [
+        [ 1 seek-absolute seek-input tell-input ] throw-on-eof
+    ] with-byte-reader
+] unit-test
+
+{ t 4 } [
+    B{ 0 1 2 3 } binary [ [
+        input-stream get [ stream-seekable? ] [ stream-length ] bi
+    ] throw-on-eof ] with-byte-reader
 ] unit-test

basis/io/streams/throwing/throwing.factor

@@ -10,8 +10,6 @@ TUPLE: throws-on-eof-stream stream ;
 
 C: <throws-on-eof-stream> throws-on-eof-stream
 
-<PRIVATE
-
 M: throws-on-eof-stream stream-element-type stream>> stream-element-type ;
 
 M: throws-on-eof-stream dispose stream>> dispose ;
@@ -34,12 +32,16 @@ M: throws-on-eof-stream stream-tell
 M: throws-on-eof-stream stream-seek
     stream>> stream-seek ;
 
+M: throws-on-eof-stream stream-seekable?
+    stream>> stream-seekable? ;
+
+M: throws-on-eof-stream stream-length
+    stream>> stream-length ;
+
 M: throws-on-eof-stream stream-read-until
     [ stream>> stream-read-until ]
     [ '[ length _ \ read-until stream-exhausted ] unless* ] bi ;
 
-PRIVATE>
-
 : stream-throw-on-eof ( ..a stream quot: ( ..a stream' -- ..b ) -- ..b )
     [ <throws-on-eof-stream> ] dip with-input-stream* ; inline
 

core/io/streams/byte-array/byte-array.factor

@@ -25,6 +25,8 @@ M: byte-reader dispose drop ;
 
 M: byte-reader stream-tell i>> ;
 M: byte-reader stream-seek (stream-seek) ;
+M: byte-reader stream-seekable? drop t ; inline
+M: byte-reader stream-length underlying>> length ; inline
 
 : <byte-reader> ( byte-array encoding -- stream )
     [ B{ } like 0 byte-reader boa ] dip <decoder> ;