io-streams 1.2.0.0 → 1.5.2.2
raw patch · 32 files changed
Files
- CONTRIBUTORS +1/−0
- changelog.md +105/−0
- io-streams.cabal +87/−47
- src/System/IO/Streams.hs +10/−0
- src/System/IO/Streams/Attoparsec.hs +4/−3
- src/System/IO/Streams/Attoparsec/ByteString.hs +75/−0
- src/System/IO/Streams/Attoparsec/Text.hs +76/−0
- src/System/IO/Streams/Builder.hs +90/−86
- src/System/IO/Streams/ByteString.hs +8/−10
- src/System/IO/Streams/Combinators.hs +125/−6
- src/System/IO/Streams/Concurrent.hs +11/−3
- src/System/IO/Streams/Core.hs +3/−0
- src/System/IO/Streams/Handle.hs +34/−4
- src/System/IO/Streams/Internal.hs +41/−15
- src/System/IO/Streams/Internal/Attoparsec.hs +57/−72
- src/System/IO/Streams/List.hs +33/−0
- src/System/IO/Streams/Text.hs +3/−0
- src/System/IO/Streams/Vector.hs +15/−4
- src/System/IO/Streams/Zlib.hs +12/−12
- test/System/IO/Streams/Tests/Attoparsec.hs +0/−111
- test/System/IO/Streams/Tests/Attoparsec/ByteString.hs +113/−0
- test/System/IO/Streams/Tests/Attoparsec/Text.hs +140/−0
- test/System/IO/Streams/Tests/Builder.hs +20/−18
- test/System/IO/Streams/Tests/ByteString.hs +5/−9
- test/System/IO/Streams/Tests/Combinators.hs +56/−0
- test/System/IO/Streams/Tests/Concurrent.hs +2/−6
- test/System/IO/Streams/Tests/Handle.hs +27/−18
- test/System/IO/Streams/Tests/List.hs +27/−1
- test/System/IO/Streams/Tests/Network.hs +26/−8
- test/System/IO/Streams/Tests/Process.hs +1/−1
- test/System/IO/Streams/Tests/Zlib.hs +5/−4
- test/TestSuite.hs +29/−17
CONTRIBUTORS view
@@ -3,6 +3,7 @@ - Gregory Collins <greg@gregorycollins.net> - Gabriel Gonzalez <gabriel439@gmail.com>+ - Ignat Insarov <kindaro@gmail.com> ------------------------------------------------------------------------------ Contains some code ported from the "blaze-builder-enumerator" package by Simon
changelog.md view
@@ -1,3 +1,108 @@+# Version 1.5.2.0+- Add `contraunzip`.++- Guard support for `network` and `zlib` by cabal flags, to support platforms+ like GHCJS where they are not available.++# Version 1.5.1.0+Fix [stackage#4312](https://github.com/commercialhaskell/stackage/issues/4312): Relax `network` upper bound++# Version 1.5.0.1+Bugfix: `concurrentMerge []` should not block forever, even if this case is+pathological.++# Version 1.5.0.0+- Changed the behaviour of `ByteString.splitOn` to not emit empty string if the+ input ends in the delimiter; now `lines` should match Prelude's. Bumped major+ version because this is a potentially breaking change (even if it is a bugfix.)++# Version 1.4.1.0++- Added `writeTo` export to the main module (forgotten when it was added to+ `.Core`.)++# Version 1.4.0.0++- Added support for Text with Attoparsec, courtesy Kevin Brubeck Unhammer. Adds+ modules `System.IO.Streams.Attoparsec.{ByteString, Text}` and deprecates+ `System.IO.Streams.Attoparsec`, which is now a thin wrapper.++# Version 1.3.6.1+- Bumped dependencies on `time` and `process`.++# Version 1.3.6.0+ - Added new fold functions:+ ```haskell+fold_ :: (x -> a -> x) -- ^ accumulator update function+ -> x -- ^ initial seed+ -> (x -> s) -- ^ recover folded value+ -> InputStream a -- ^ input stream+ -> IO s+foldM_ :: (x -> a -> IO x) -- ^ accumulator update action+ -> IO x -- ^ initial seed+ -> (x -> IO s) -- ^ recover folded value+ -> InputStream a -- ^ input stream+ -> IO s+ ```++# Version 1.3.5.0+ - Add support for latest `process`, `time`, and `transformers` releases+ (and thereby indirectly for the upcoming GHC 8.0).++# Version 1.3.4.0+ - Added `System.IO.Streams.Handle.handleToStreams`, to conveniently+ create an `InputStream`/`OutputStream` pair.++# Version 1.3.3.1+ - Fixed a testsuite compile error on GHC >= 7.10.++# Version 1.3.3.0+ - Added a new convenience function, like `chunkList` but with a predicate for+ when to split, taking current element and current chunk length:+ ```haskell+chunkListWith :: (a -> Int -> Bool) -> InputStream a -> IO (InputStream [a])+ ```++# Version 1.3.2.0+ - Dependency bump for attoparsec 0.13 (another location)+ - Dependency bump for vector 0.11+ - Dependency bump for zlib 0.6++# Version 1.3.1.0+ - Dependency bump for attoparsec 0.13.++# Version 1.3.0.0+ - As long promised, removed the direct use of the `blaze-builder` package in+ favor of the new `bytestring-builder` transitional package (to be replaced+ by bytestring's native builder once it is mature enough).+ - Added a new convenience function, a flipped version of `write`:+ ```haskell+writeTo :: OutputStream a -> Maybe a -> IO ()+ ```++# Version 1.2.1.3+ - Dependency bump for primitive 0.6.++# Version 1.2.1.2+ - Dependency bump for deepseq 1.4.++# Version 1.2.1.1+ - Dependency bump for time 1.6.++# Version 1.2.1.0+ - Added `System.IO.Streams.mapMaybe` for InputStream.++ - Added `System.IO.Streams.contramapMaybe` for OutputStream.++# Version 1.2.0.1++ - `System.IO.Streams.Attoparsec.parseFromStream`: export more information+ about the context of parse errors to the message returned via+ `ParseException`.++ - Improved documentation about stream flushing in the docstring for+ `handleToOutputStream`.+ # Version 1.2.0.0 - Fixed bug #27 (https://github.com/snapframework/io-streams/issues/27): makeOutputStream now properly shuts down the stream upon receiving EOF. The
io-streams.cabal view
@@ -1,5 +1,5 @@ Name: io-streams-Version: 1.2.0.0+Version: 1.5.2.2 License: BSD3 License-file: LICENSE Category: Data, Network, IO-Streams@@ -7,8 +7,21 @@ Maintainer: Gregory Collins <greg@gregorycollins.net> Cabal-version: >= 1.10 Synopsis: Simple, composable, and easy-to-use stream I/O-Tested-With: GHC==7.8.2, GHC==7.6.2, GHC==7.6.1, GHC==7.4.2, GHC==7.4.1,- GHC==7.2.2, GHC==7.0.4+Tested-With:+ GHC == 9.4.1+ GHC == 9.2.4+ GHC == 9.0.2+ GHC == 8.10.7+ GHC == 8.8.4+ GHC == 8.6.5+ GHC == 8.4.4+ GHC == 8.2.2+ GHC == 8.0.2+ GHC == 7.10.3+ GHC == 7.8.4+ GHC == 7.6.3+ GHC == 7.4.2+ Bug-Reports: https://github.com/snapframework/io-streams/issues Description: /Overview/@@ -85,6 +98,16 @@ Description: Do not run interactive tests Default: False +Flag Zlib+ Description: Include zlib support+ Default: True+ Manual: True++Flag Network+ Description: Include network support+ Default: True+ Manual: True+ ------------------------------------------------------------------------------ Library hs-source-dirs: src@@ -93,10 +116,10 @@ ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -fno-warn-unused-do-bind - ghc-prof-options: -prof -auto-all- Exposed-modules: System.IO.Streams, System.IO.Streams.Attoparsec,+ System.IO.Streams.Attoparsec.ByteString,+ System.IO.Streams.Attoparsec.Text, System.IO.Streams.Builder, System.IO.Streams.ByteString, System.IO.Streams.Combinators,@@ -106,38 +129,47 @@ System.IO.Streams.Handle, System.IO.Streams.File, System.IO.Streams.List,- System.IO.Streams.Network, System.IO.Streams.Process, System.IO.Streams.Text, System.IO.Streams.Vector,- System.IO.Streams.Zlib, System.IO.Streams.Internal, System.IO.Streams.Tutorial Other-modules: System.IO.Streams.Internal.Attoparsec,- System.IO.Streams.Internal.Network, System.IO.Streams.Internal.Search - Build-depends: base >= 4 && <5,- attoparsec >= 0.10 && <0.13,- blaze-builder >= 0.3.1 && <0.4,- bytestring >= 0.9 && <0.11,- network >= 2.3 && <2.7,- primitive >= 0.2 && <0.6,- process >= 1 && <1.3,- text >= 0.10 && <1.3,- time >= 1.2 && <1.5,- transformers >= 0.2 && <0.5,- vector >= 0.7 && <0.11,- zlib-bindings >= 0.1 && <0.2+ Build-depends: base >= 4 && <5,+ attoparsec >= 0.10 && <0.15,+ bytestring >= 0.9 && <0.12,+ primitive >= 0.2 && <0.8,+ process >= 1.1 && <1.7,+ text >=0.10 && <1.3 || >= 2.0 && <2.1,+ time >= 1.2 && <1.13,+ transformers >= 0.2 && <0.7,+ vector >= 0.7 && <0.14 + if !impl(ghc >= 7.8)+ Build-depends: bytestring-builder >= 0.10 && <0.11+ if impl(ghc >= 7.2) other-extensions: Trustworthy + if flag(Zlib)+ Exposed-modules: System.IO.Streams.Zlib+ Build-depends: zlib-bindings >= 0.1 && <0.2+ cpp-options: -DENABLE_ZLIB++ if flag(Network)+ Exposed-modules: System.IO.Streams.Network+ Other-modules: System.IO.Streams.Internal.Network+ Build-depends: network >= 2.3 && <3.2+ cpp-options: -DENABLE_NETWORK+ other-extensions: BangPatterns, CPP, DeriveDataTypeable,+ FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses,@@ -153,7 +185,8 @@ Main-is: TestSuite.hs Default-language: Haskell2010 - Other-modules: System.IO.Streams.Tests.Attoparsec,+ Other-modules: System.IO.Streams.Tests.Attoparsec.ByteString,+ System.IO.Streams.Tests.Attoparsec.Text, System.IO.Streams.Tests.Builder, System.IO.Streams.Tests.ByteString, System.IO.Streams.Tests.Combinators,@@ -164,13 +197,12 @@ System.IO.Streams.Tests.Handle, System.IO.Streams.Tests.Internal, System.IO.Streams.Tests.List,- System.IO.Streams.Tests.Network, System.IO.Streams.Tests.Process, System.IO.Streams.Tests.Text, System.IO.Streams.Tests.Vector,- System.IO.Streams.Tests.Zlib, System.IO.Streams,- System.IO.Streams.Attoparsec,+ System.IO.Streams.Attoparsec.ByteString,+ System.IO.Streams.Attoparsec.Text, System.IO.Streams.Builder, System.IO.Streams.ByteString, System.IO.Streams.Combinators,@@ -180,48 +212,56 @@ System.IO.Streams.Handle, System.IO.Streams.File, System.IO.Streams.List,- System.IO.Streams.Network, System.IO.Streams.Process, System.IO.Streams.Text, System.IO.Streams.Vector,- System.IO.Streams.Zlib, System.IO.Streams.Internal, System.IO.Streams.Internal.Attoparsec,- System.IO.Streams.Internal.Network, System.IO.Streams.Internal.Search - ghc-options: -Wall -fhpc -fwarn-tabs -funbox-strict-fields -threaded+ ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -threaded -fno-warn-unused-do-bind- ghc-prof-options: -prof -auto-all if !os(windows) && !flag(NoInteractiveTests) cpp-options: -DENABLE_PROCESS_TESTS + if flag(Zlib)+ Other-modules: System.IO.Streams.Tests.Zlib,+ System.IO.Streams.Zlib+ Build-depends: zlib-bindings,+ zlib >= 0.5 && <0.7+ cpp-options: -DENABLE_ZLIB - Build-depends: base >= 4 && <5,- attoparsec >= 0.10 && <0.13,- blaze-builder >= 0.3.1 && <0.4,- bytestring >= 0.9 && <0.11,- deepseq >= 1.2 && <1.4,- directory >= 1.1 && <2,- filepath >= 1.2 && <2,- mtl >= 2 && <3,- network >= 2.3 && <2.7,- primitive >= 0.2 && <0.6,- process >= 1 && <1.3,- text >= 0.10 && <1.3,- time >= 1.2 && <1.5,- transformers >= 0.2 && <0.5,- vector >= 0.7 && <0.11,- zlib-bindings >= 0.1 && <0.2,+ if flag(Network)+ Other-modules: System.IO.Streams.Internal.Network,+ System.IO.Streams.Network,+ System.IO.Streams.Tests.Network+ Build-depends: network+ cpp-options: -DENABLE_NETWORK + Build-depends: base,+ attoparsec,+ bytestring,+ deepseq >= 1.2 && <1.5,+ directory >= 1.1 && <2,+ filepath >= 1.2 && <2,+ mtl >= 2 && <3,+ primitive,+ process,+ text,+ time,+ transformers,+ vector,+ HUnit >= 1.2 && <2, QuickCheck >= 2.3.0.2 && <3, test-framework >= 0.6 && <0.9, test-framework-hunit >= 0.2.7 && <0.4,- test-framework-quickcheck2 >= 0.2.12.1 && <0.4,- zlib >= 0.5 && <0.6+ test-framework-quickcheck2 >= 0.2.12.1 && <0.4++ if !impl(ghc >= 7.8)+ Build-depends: bytestring-builder if impl(ghc >= 7.2) other-extensions: Trustworthy
src/System/IO/Streams.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} @@ -34,6 +35,7 @@ , unRead , peek , write+ , writeTo , atEOF -- * Connecting streams together@@ -65,11 +67,15 @@ , module System.IO.Streams.Handle , module System.IO.Streams.File , module System.IO.Streams.List+#ifdef ENABLE_NETWORK , module System.IO.Streams.Network+#endif , module System.IO.Streams.Process , module System.IO.Streams.Text , module System.IO.Streams.Vector+#ifdef ENABLE_ZLIB , module System.IO.Streams.Zlib+#endif ) where ------------------------------------------------------------------------------@@ -84,11 +90,15 @@ import System.IO.Streams.File import System.IO.Streams.Handle import System.IO.Streams.List+#ifdef ENABLE_NETWORK import System.IO.Streams.Network+#endif import System.IO.Streams.Process import System.IO.Streams.Text import System.IO.Streams.Vector+#ifdef ENABLE_ZLIB import System.IO.Streams.Zlib+#endif ------------------------------------------------------------------------------ -- $generator
src/System/IO/Streams/Attoparsec.hs view
@@ -1,5 +1,6 @@--- | This module provides support for parsing values from 'InputStream's using--- @attoparsec@.+-- | This module is deprecated -- use+-- System.IO.Streams.Attoparsec.ByteString instead (this module simply+-- re-exports that one). module System.IO.Streams.Attoparsec ( -- * Parsing@@ -9,4 +10,4 @@ ) where -------------------------------------------------------------------------------import System.IO.Streams.Internal.Attoparsec (ParseException (..), parseFromStream, parserToInputStream)+import System.IO.Streams.Attoparsec.ByteString (ParseException (..), parseFromStream, parserToInputStream)
+ src/System/IO/Streams/Attoparsec/ByteString.hs view
@@ -0,0 +1,75 @@+-- | This module provides support for parsing values from ByteString+-- 'InputStream's using @attoparsec@. /Since: 1.4.0.0./++module System.IO.Streams.Attoparsec.ByteString+ ( -- * Parsing+ parseFromStream+ , parserToInputStream+ , ParseException(..)+ ) where++------------------------------------------------------------------------------+import Data.Attoparsec.ByteString.Char8 (Parser)+import Data.ByteString (ByteString)+------------------------------------------------------------------------------+import System.IO.Streams.Internal (InputStream)+import qualified System.IO.Streams.Internal as Streams+import System.IO.Streams.Internal.Attoparsec (ParseData (..), ParseException (..), parseFromStreamInternal)++------------------------------------------------------------------------------+-- | Supplies an @attoparsec@ 'Parser' with an 'InputStream', returning the+-- final parsed value or throwing a 'ParseException' if parsing fails.+--+-- 'parseFromStream' consumes only as much input as necessary to satisfy the+-- 'Parser': any unconsumed input is pushed back onto the 'InputStream'.+--+-- If the 'Parser' exhausts the 'InputStream', the end-of-stream signal is sent+-- to attoparsec.+--+-- Example:+--+-- @+-- ghci> import "Data.Attoparsec.ByteString.Char8"+-- ghci> is <- 'System.IO.Streams.fromList' [\"12345xxx\" :: 'ByteString']+-- ghci> 'parseFromStream' ('Data.Attoparsec.ByteString.Char8.takeWhile' 'Data.Attoparsec.ByteString.Char8.isDigit') is+-- \"12345\"+-- ghci> 'System.IO.Streams.read' is+-- Just \"xxx\"+-- @+parseFromStream :: Parser r+ -> InputStream ByteString+ -> IO r+parseFromStream = parseFromStreamInternal parse feed++------------------------------------------------------------------------------+-- | Given a 'Parser' yielding values of type @'Maybe' r@, transforms an+-- 'InputStream' over byte strings to an 'InputStream' yielding values of type+-- @r@.+--+-- If the parser yields @Just x@, then @x@ will be passed along downstream, and+-- if the parser yields @Nothing@, that will be interpreted as end-of-stream.+--+-- Upon a parse error, 'parserToInputStream' will throw a 'ParseException'.+--+-- Example:+--+-- @+-- ghci> import "Control.Applicative"+-- ghci> import "Data.Attoparsec.ByteString.Char8"+-- ghci> is <- 'System.IO.Streams.fromList' [\"1 2 3 4 5\" :: 'ByteString']+-- ghci> let parser = ('Data.Attoparsec.ByteString.Char8.endOfInput' >> 'Control.Applicative.pure' 'Nothing') \<|\> (Just \<$\> ('Data.Attoparsec.ByteString.Char8.skipWhile' 'Data.Attoparsec.ByteString.Char8.isSpace' *> 'Data.Attoparsec.ByteString.Char8.decimal'))+-- ghci> 'parserToInputStream' parser is >>= 'System.IO.Streams.toList'+-- [1,2,3,4,5]+-- ghci> is' \<- 'System.IO.Streams.fromList' [\"1 2xx3 4 5\" :: 'ByteString'] >>= 'parserToInputStream' parser+-- ghci> 'read' is'+-- Just 1+-- ghci> 'read' is'+-- Just 2+-- ghci> 'read' is'+-- *** Exception: Parse exception: Failed reading: takeWhile1+-- @+parserToInputStream :: Parser (Maybe r)+ -> InputStream ByteString+ -> IO (InputStream r)+parserToInputStream = (Streams.makeInputStream .) . parseFromStream+{-# INLINE parserToInputStream #-}
+ src/System/IO/Streams/Attoparsec/Text.hs view
@@ -0,0 +1,76 @@+-- | This module provides support for parsing values from Text+-- 'InputStream's using @attoparsec@. /Since: 1.4.0.0./++module System.IO.Streams.Attoparsec.Text+ ( -- * Parsing+ parseFromStream+ , parserToInputStream+ , ParseException(..)+ ) where++------------------------------------------------------------------------------+import Data.Attoparsec.Text (Parser)+import Data.Text (Text)+------------------------------------------------------------------------------+import System.IO.Streams.Internal (InputStream)+import qualified System.IO.Streams.Internal as Streams+import System.IO.Streams.Internal.Attoparsec (ParseData (..), ParseException (..), parseFromStreamInternal)+++------------------------------------------------------------------------------+-- | Supplies an @attoparsec@ 'Parser' with an 'InputStream', returning the+-- final parsed value or throwing a 'ParseException' if parsing fails.+--+-- 'parseFromStream' consumes only as much input as necessary to satisfy the+-- 'Parser': any unconsumed input is pushed back onto the 'InputStream'.+--+-- If the 'Parser' exhausts the 'InputStream', the end-of-stream signal is sent+-- to attoparsec.+--+-- Example:+--+-- @+-- ghci> import "Data.Attoparsec.Text"+-- ghci> is <- 'System.IO.Streams.fromList' [\"12345xxx\" :: 'Text']+-- ghci> 'parseFromStream' ('Data.Attoparsec.Text.takeWhile' 'Data.Char.isDigit') is+-- \"12345\"+-- ghci> 'System.IO.Streams.read' is+-- Just \"xxx\"+-- @+parseFromStream :: Parser r+ -> InputStream Text+ -> IO r+parseFromStream = parseFromStreamInternal parse feed++------------------------------------------------------------------------------+-- | Given a 'Parser' yielding values of type @'Maybe' r@, transforms an+-- 'InputStream' over byte strings to an 'InputStream' yielding values of type+-- @r@.+--+-- If the parser yields @Just x@, then @x@ will be passed along downstream, and+-- if the parser yields @Nothing@, that will be interpreted as end-of-stream.+--+-- Upon a parse error, 'parserToInputStream' will throw a 'ParseException'.+--+-- Example:+--+-- @+-- ghci> import "Control.Applicative"+-- ghci> import "Data.Attoparsec.Text"+-- ghci> is <- 'System.IO.Streams.fromList' [\"1 2 3 4 5\" :: 'Text']+-- ghci> let parser = ('Data.Attoparsec.Text.endOfInput' >> 'Control.Applicative.pure' 'Nothing') \<|\> (Just \<$\> ('Data.Attoparsec.Text.skipWhile' 'Data.Attoparsec.Text.isSpace' *> 'Data.Attoparsec.Text.decimal'))+-- ghci> 'parserToInputStream' parser is >>= 'System.IO.Streams.toList'+-- [1,2,3,4,5]+-- ghci> is' \<- 'System.IO.Streams.fromList' [\"1 2xx3 4 5\" :: 'Text'] >>= 'parserToInputStream' parser+-- ghci> 'read' is'+-- Just 1+-- ghci> 'read' is'+-- Just 2+-- ghci> 'read' is'+-- *** Exception: Parse exception: Failed reading: takeWhile1+-- @+parserToInputStream :: Parser (Maybe r)+ -> InputStream Text+ -> IO (InputStream r)+parserToInputStream = (Streams.makeInputStream .) . parseFromStream+{-# INLINE parserToInputStream #-}
src/System/IO/Streams/Builder.hs view
@@ -1,18 +1,20 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} -- | Buffering for output streams based on bytestring builders. -- -- Buffering an output stream can often improve throughput by reducing the--- number of system calls made through the file descriptor. The @blaze-builder@--- package provides an efficient set of primitives for serializing values--- directly to an output buffer.+-- number of system calls made through the file descriptor. The @bytestring@+-- package provides an efficient monoidal datatype used for serializing values+-- directly to an output buffer, called a 'Builder', originally implemented in+-- the @blaze-builder@ package by Simon Meier. When compiling with @bytestring@+-- versions older than 0.10.4, (i.e. GHC <= 7.6) users must depend on the+-- @bytestring-builder@ library to get the new builder implementation. Since we+-- try to maintain compatibility with the last three GHC versions, the+-- dependency on @bytestring-builder@ can be dropped after the release of GHC+-- 7.12. ----- (/N.B./: most of the @blaze-builder@ package has been moved into--- @bytestring@ in versions \>= 0.10; once two or three Haskell Platform--- editions have been released that contain @bytestring@ 0.10 or higher, the--- dependency on @blaze-builder@ will be dropped in favor of the native support--- for 'Builder' contained in the @bytestring@ package.) -- -- /Using this module/ --@@ -27,24 +29,24 @@ -- @ -- do -- newStream <- Streams.'builderStream' someOutputStream--- Streams.'write' ('Just' $ 'Blaze.ByteString.Builder.fromByteString' \"hello\") newStream+-- Streams.'write' ('Just' $ 'Data.ByteString.Builder.byteString' \"hello\") newStream -- .... -- @ -- ----- You can flush the output buffer using 'Blaze.ByteString.Builder.flush':+-- You can flush the output buffer using 'Data.ByteString.Builder.Extra.flush': -- -- @ -- ....--- Streams.'write' ('Just' 'Blaze.ByteString.Builder.flush') newStream+-- Streams.'write' ('Just' 'Data.ByteString.Builder.Extra.flush') newStream -- .... -- @ -- -- As a convention, 'builderStream' will write the empty string to the wrapped -- 'OutputStream' upon a builder buffer flush. Output streams which receive -- 'ByteString' should either ignore the empty string or interpret it as a--- signal to flush their own buffers, as the "System.IO.Streams.Zlib" functions--- do.+-- signal to flush their own buffers, as the @handleToOutputStream@ and+-- "System.IO.Streams.Zlib" functions do. -- -- /Example/ --@@ -53,7 +55,7 @@ -- example = do -- let l1 = 'Data.List.intersperse' \" \" [\"the\", \"quick\", \"brown\", \"fox\"] -- let l2 = 'Data.List.intersperse' \" \" [\"jumped\", \"over\", \"the\"]--- let l = map 'Blaze.ByteString.Builder.fromByteString' l1 ++ ['Blaze.ByteString.Builder.flush'] ++ map 'Blaze.ByteString.Builder.fromByteString' l2+-- let l = map 'Data.ByteString.Builder.byteString' l1 ++ ['Data.ByteString.Builder.Extra.flush'] ++ map 'Data.ByteString.Builder.byteString' l2 -- is \<- Streams.'System.IO.Streams.fromList' l -- (os0, grab) \<- Streams.'System.IO.Streams.listOutputStream' -- os \<- Streams.'builderStream' os0@@ -66,23 +68,83 @@ module System.IO.Streams.Builder ( -- * Blaze builder conversion builderStream+ , builderStreamWithBufferSize , unsafeBuilderStream- , builderStreamWith ) where -------------------------------------------------------------------------------import Control.Monad (when)-import Data.ByteString.Char8 (ByteString)-import qualified Data.ByteString.Char8 as S-import Data.IORef (newIORef, readIORef, writeIORef)+import Control.Monad (when)+import Data.ByteString.Builder.Internal (Buffer (..), BufferRange (..), Builder, byteStringFromBuffer, defaultChunkSize, fillWithBuildStep, newBuffer, runBuilder)+import Data.ByteString.Char8 (ByteString)+import qualified Data.ByteString.Char8 as S+import Data.IORef (newIORef, readIORef, writeIORef)+ -------------------------------------------------------------------------------import Blaze.ByteString.Builder.Internal (defaultBufferSize)-import Blaze.ByteString.Builder.Internal.Buffer (Buffer, BufferAllocStrategy, allNewBuffersStrategy, execBuildStep, reuseBufferStrategy, unsafeFreezeBuffer, unsafeFreezeNonEmptyBuffer, updateEndOfSlice)-import Blaze.ByteString.Builder.Internal.Types (BufRange (..), BuildSignal (..), Builder (..), buildStep)-import System.IO.Streams.Internal (OutputStream, makeOutputStream, write)+import System.IO.Streams.Internal (OutputStream, makeOutputStream, write, writeTo) ------------------------------------------------------------------------------+builderStreamWithBufferFunc :: IO Buffer+ -> OutputStream ByteString+ -> IO (OutputStream Builder)+builderStreamWithBufferFunc mkNewBuf os = do+ ref <- newIORef Nothing+ makeOutputStream $ chunk ref+ where+ chunk ref Nothing = do+ mbuf <- readIORef ref+ case mbuf of+ -- If we existing buffer leftovers, write them to the output.+ Nothing -> return $! ()+ Just buf -> writeBuf buf+ write Nothing os+ chunk ref (Just builder) = runStep ref $ runBuilder builder++ getBuf ref = readIORef ref >>= maybe mkNewBuf return++ bumpBuf (Buffer fp (BufferRange !_ endBuf)) endPtr =+ Buffer fp (BufferRange endPtr endBuf)++ updateBuf ref buf endPtr = writeIORef ref $! Just $! bumpBuf buf endPtr++ writeBuf buf = do+ let bs = byteStringFromBuffer buf+ when (not . S.null $ bs) $ writeTo os $! Just bs++ bufRange (Buffer _ rng) = rng++ runStep ref step = do+ buf <- getBuf ref+ fillWithBuildStep step (cDone buf) (cFull buf) (cInsert buf)+ (bufRange buf)+ where+ cDone buf endPtr !() = updateBuf ref buf endPtr+ cFull buf !endPtr !_ newStep = do+ writeBuf $! bumpBuf buf endPtr+ writeIORef ref Nothing+ runStep ref newStep+ cInsert buf !endPtr !bs newStep = do+ writeBuf $! bumpBuf buf endPtr+ writeIORef ref Nothing+ writeTo os $! Just bs+ runStep ref newStep+++------------------------------------------------------------------------------+-- | Converts a 'ByteString' sink into a 'Builder' sink, using the supplied+-- buffer size.+--+-- Note that if the generated builder receives a+-- 'Blaze.ByteString.Builder.flush', by convention it will send an empty string+-- to the supplied @'OutputStream' 'ByteString'@ to indicate that any output+-- buffers are to be flushed.+--+-- /Since: 1.3.0.0./+builderStreamWithBufferSize :: Int -> OutputStream ByteString -> IO (OutputStream Builder)+builderStreamWithBufferSize bufsiz = builderStreamWithBufferFunc (newBuffer bufsiz)+++------------------------------------------------------------------------------ -- | Converts a 'ByteString' sink into a 'Builder' sink. -- -- Note that if the generated builder receives a@@ -91,7 +153,7 @@ -- buffers are to be flushed. -- builderStream :: OutputStream ByteString -> IO (OutputStream Builder)-builderStream = builderStreamWith (allNewBuffersStrategy defaultBufferSize)+builderStream = builderStreamWithBufferSize defaultChunkSize ------------------------------------------------------------------------------@@ -108,69 +170,11 @@ -- 'Data.ByteString.copy' to ensure that you have a fresh copy of the -- underlying string. ----- You can create a Buffer with--- 'Blaze.ByteString.Builder.Internal.Buffer.allocBuffer'.---+-- You can create a Buffer with 'Data.ByteString.Builder.Internal.newBuffer'. -- unsafeBuilderStream :: IO Buffer -> OutputStream ByteString -> IO (OutputStream Builder)-unsafeBuilderStream = builderStreamWith . reuseBufferStrategy------------------------------------------------------------------------------------ | A customized version of 'builderStream', using the specified--- 'BufferAllocStrategy'.-builderStreamWith :: BufferAllocStrategy- -> OutputStream ByteString- -> IO (OutputStream Builder)-builderStreamWith (ioBuf0, nextBuf) os = do- bufRef <- newIORef ioBuf0- makeOutputStream $ sink bufRef- where- sink bufRef m = do- buf <- readIORef bufRef- maybe (eof buf) (chunk buf) m- where- eof ioBuf = do- buf <- ioBuf- case unsafeFreezeNonEmptyBuffer buf of- Nothing -> write Nothing os- x@(Just s) -> do- when (not $ S.null s) $ write x os- write Nothing os-- chunk ioBuf c = feed bufRef (unBuilder c (buildStep finalStep)) ioBuf-- finalStep !(BufRange pf _) = return $! Done pf $! ()-- feed bufRef bStep ioBuf = do- !buf <- ioBuf- signal <- execBuildStep bStep buf-- case signal of- Done op' _ ->- writeIORef bufRef $ (return (updateEndOfSlice buf op'))-- BufferFull minSize op' bStep' -> do- let buf' = updateEndOfSlice buf op'- {-# INLINE cont #-}- cont = do- ioBuf' <- nextBuf minSize buf'- feed bufRef bStep' ioBuf'-- write (Just $! unsafeFreezeBuffer buf') os- cont-- InsertByteString op' bs bStep' -> do- let buf' = updateEndOfSlice buf op'-- case unsafeFreezeNonEmptyBuffer buf' of- Nothing -> return $! ()- x -> write x os-- -- empty string here notifies downstream of flush- write (Just bs) os-- ioBuf' <- nextBuf 1 buf'- feed bufRef bStep' ioBuf'+unsafeBuilderStream mkBuf os = do+ buf <- mkBuf+ builderStreamWithBufferFunc (return buf) os
src/System/IO/Streams/ByteString.hs view
@@ -61,7 +61,7 @@ import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.Time.Clock.POSIX (getPOSIXTime) import Data.Typeable (Typeable)-import Prelude hiding (read, lines, unlines, words, unwords)+import Prelude hiding (lines, read, unlines, unwords, words) ------------------------------------------------------------------------------ import System.IO.Streams.Combinators (filterM, intersperse, outputFoldM) import System.IO.Streams.Internal (InputStream (..), OutputStream, makeInputStream, makeOutputStream, read, unRead, write)@@ -272,6 +272,10 @@ -- -- * consecutive delimiters are not merged. --+-- * if the input ends in the delimiter, a final empty string is /not/+-- emitted. (/Since: 1.5.0.0. Previous versions had the opposite behaviour,+-- which was changed to match 'Prelude.lines'./)+-- -- Example: -- -- @@@ -305,15 +309,9 @@ else do let !b' = S.unsafeDrop 1 b dl <- readIORef ref-- if S.null b'- then do- writeIORef ref ("" :)- return $ Just $! S.concat $ dl [a]- else do- writeIORef ref id- unRead b' is- return $ Just $! S.concat $ dl [a]+ when (not $ S.null b') $ unRead b' is+ writeIORef ref id+ return $ Just $! S.concat $ dl [a] ------------------------------------------------------------------------------
src/System/IO/Streams/Combinators.hs view
@@ -10,6 +10,8 @@ , outputFoldM , fold , foldM+ , fold_+ , foldM_ , any , all , maximum@@ -22,9 +24,11 @@ , map , mapM , mapM_+ , mapMaybe , contramap , contramapM , contramapM_+ , contramapMaybe -- * Filter , filter@@ -43,6 +47,7 @@ , zipWith , zipWithM , unzip+ , contraunzip -- * Utility , intersperse@@ -67,7 +72,7 @@ ------------------------------------------------------------------------------ -- | A side-effecting fold over an 'OutputStream', as a stream transformer. ----- The IO action returned by 'outputFoldM' can be used to fetch the updated+-- The IO action returned by 'outputFoldM' can be used to fetch and reset the updated -- seed value. Example: -- -- @@@ -84,8 +89,8 @@ -> a -- ^ initial seed -> OutputStream b -- ^ output stream -> IO (OutputStream b, IO a) -- ^ returns a new stream as well as- -- an IO action to fetch the updated- -- seed value.+ -- an IO action to fetch and reset the+ -- updated seed value. outputFoldM f initial stream = do ref <- newIORef initial os <- makeOutputStream (wr ref)@@ -105,7 +110,7 @@ ------------------------------------------------------------------------------ -- | A side-effecting fold over an 'InputStream', as a stream transformer. ----- The IO action returned by 'inputFoldM' can be used to fetch the updated seed+-- The IO action returned by 'inputFoldM' can be used to fetch and reset the updated seed -- value. Example: -- -- @@@ -120,8 +125,8 @@ -> a -- ^ initial seed -> InputStream b -- ^ input stream -> IO (InputStream b, IO a) -- ^ returns a new stream as well as an- -- IO action to fetch the updated seed- -- value.+ -- IO action to fetch and reset the+ -- updated seed value. inputFoldM f initial stream = do ref <- newIORef initial is <- makeInputStream (rd ref)@@ -180,6 +185,61 @@ ------------------------------------------------------------------------------+-- | A variant of 'System.IO.Streams.fold' suitable for use with composable folds+-- from \'beautiful folding\' libraries like+-- <http://hackage.haskell.org/package/foldl the foldl library>.+-- The input stream is fully consumed. +--+-- Example:+--+-- @+-- ghci> let folds = liftA3 (,,) Foldl.length Foldl.mean Foldl.maximum+-- ghci> Streams.'System.IO.Streams.fromList' [1..10::Double] >>= Foldl.purely Streams.'System.IO.Streams.fold_' folds is+-- ghci> (10,5.5,Just 10.0)+-- @+--+-- /Since 1.3.6.0/+--+fold_ :: (x -> a -> x) -- ^ accumulator update function+ -> x -- ^ initial seed+ -> (x -> s) -- ^ recover folded value+ -> InputStream a -- ^ input stream+ -> IO s+fold_ op seed done stream = liftM done (go seed)+ where + go !s = read stream >>= maybe (return s) (go . op s)+++------------------------------------------------------------------------------+-- | A variant of 'System.IO.Streams.foldM' suitable for use with composable folds+-- from \'beautiful folding\' libraries like+-- <http://hackage.haskell.org/package/foldl the foldl library>.+-- The input stream is fully consumed. +--+-- Example:+--+-- @+-- ghci> let folds = Foldl.mapM_ print *> Foldl.generalize (liftA2 (,) Foldl.sum Foldl.mean)+-- ghci> Streams.'System.IO.Streams.fromList' [1..3::Double] >>= Foldl.impurely Streams.'System.IO.Streams.foldM_' folds+-- 1.0+-- 2.0+-- 3.0+-- (6.0,2.0)+-- @+--+-- /Since 1.3.6.0/+--+foldM_ :: (x -> a -> IO x) -- ^ accumulator update action+ -> IO x -- ^ initial seed+ -> (x -> IO s) -- ^ recover folded value+ -> InputStream a -- ^ input stream+ -> IO s+foldM_ f seed done stream = seed >>= go + where+ go !x = read stream >>= maybe (done x) ((go =<<) . f x)+++------------------------------------------------------------------------------ -- | @any predicate stream@ returns 'True' if any element in @stream@ matches -- the predicate. --@@ -370,6 +430,33 @@ ------------------------------------------------------------------------------+-- | A version of map that discards elements+--+-- @mapMaybe f s@ passes all output from @s@ through the function @f@ and+-- discards elements for which @f s@ evaluates to 'Nothing'.+--+-- Example:+--+-- @+-- ghci> Streams.'System.IO.Streams.fromList' [Just 1, None, Just 3] >>=+-- Streams.'mapMaybe' 'id' >>=+-- Streams.'System.IO.Streams.toList'+-- [1,3]+-- @+--+-- /Since: 1.2.1.0/+mapMaybe :: (a -> Maybe b) -> InputStream a -> IO (InputStream b)+mapMaybe f src = makeInputStream g+ where+ g = do+ s <- read src+ case s of+ Nothing -> return Nothing+ Just x ->+ case f x of+ Nothing -> g+ y -> return y+------------------------------------------------------------------------------ -- | Contravariant counterpart to 'map'. -- -- @contramap f s@ passes all input to @s@ through the function @f@.@@ -418,6 +505,24 @@ ------------------------------------------------------------------------------+-- | Contravariant counterpart to 'contramapMaybe'.+--+-- @contramap f s@ passes all input to @s@ through the function @f@.+-- Discards all the elements for which @f@ returns 'Nothing'.+--+-- /Since: 1.2.1.0/+--+contramapMaybe :: (a -> Maybe b) -> OutputStream b -> IO (OutputStream a)+contramapMaybe f s = makeOutputStream $ g+ where+ g Nothing = write Nothing s+ g (Just a) =+ case f a of+ Nothing -> return ()+ x -> write x s+++------------------------------------------------------------------------------ -- | Drives an 'InputStream' to end-of-stream, discarding all of the yielded -- values. skipToEof :: InputStream a -> IO ()@@ -644,6 +749,20 @@ let (a, b) = proj x modifyIORef buf (. (b:)) return $! Just a)+++------------------------------------------------------------------------------+-- | Given two 'OutputStream's, returns a new stream that "unzips" the tuples+-- being written, writing the two elements to the corresponding given streams.+--+-- You can use this together with @'contramap' (\\ x -> (x, x))@ to "fork" a+-- stream into two.+--+-- /Since: 1.5.2.0/+contraunzip :: OutputStream a -> OutputStream b -> IO (OutputStream (a, b))+contraunzip sink1 sink2 = makeOutputStream $ \ tuple -> do+ write (fmap fst tuple) sink1+ write (fmap snd tuple) sink2 ------------------------------------------------------------------------------
src/System/IO/Streams/Concurrent.hs view
@@ -1,6 +1,7 @@ -- | Stream utilities for working with concurrent channels. {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-} module System.IO.Streams.Concurrent ( -- * Channel conversions@@ -12,7 +13,9 @@ ) where ------------------------------------------------------------------------------+#if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>), (<*>))+#endif import Control.Concurrent (forkIO) import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan) import Control.Concurrent.MVar (modifyMVar, newEmptyMVar, newMVar, putMVar, takeMVar)@@ -20,7 +23,7 @@ import Control.Monad (forM_) import Prelude hiding (read) -------------------------------------------------------------------------------import System.IO.Streams.Internal (InputStream, OutputStream, makeInputStream, makeOutputStream, read)+import System.IO.Streams.Internal (InputStream, OutputStream, makeInputStream, makeOutputStream, nullInput, read) ------------------------------------------------------------------------------@@ -57,9 +60,14 @@ -- produced stream does not yield end-of-stream until all of the input streams -- have finished. ----- This traps exceptions in each concurrent thread and re-raises them in the--- current thread.+-- Any exceptions raised in one of the worker threads will be trapped and+-- re-raised in the current thread.+--+-- If the supplied list is empty, `concurrentMerge` will return an empty+-- stream. (/Since: 1.5.0.1/)+-- concurrentMerge :: [InputStream a] -> IO (InputStream a)+concurrentMerge [] = nullInput concurrentMerge iss = do mv <- newEmptyMVar nleft <- newMVar $! length iss
src/System/IO/Streams/Core.hs view
@@ -17,6 +17,7 @@ , unRead , peek , write+ , writeTo , atEOF -- * Connecting streams together@@ -24,6 +25,8 @@ , connectTo , supply , supplyTo+ , appendInputStream+ , concatInputStreams -- * Thread safety \/ concurrency , lockingInputStream
src/System/IO/Streams/Handle.hs view
@@ -10,6 +10,7 @@ ( -- * Handle conversions handleToInputStream , handleToOutputStream+ , handleToStreams , inputStreamToHandle , outputStreamToHandle , streamPairToHandle@@ -56,6 +57,11 @@ -- Note that the wrapped handle is /not/ closed when it receives end-of-stream; -- you can use 'System.IO.Streams.Combinators.atEndOfOutput' to close the -- handle if you would like this behaviour.+--+-- /Note/: to force the 'Handle' to be flushed, you can write a null string to+-- the returned 'OutputStream':+--+-- > Streams.write (Just "") os handleToOutputStream :: Handle -> IO (OutputStream ByteString) handleToOutputStream h = makeOutputStream f where@@ -66,6 +72,29 @@ ------------------------------------------------------------------------------+-- | Converts a readable and writable handle into an 'InputStream'/'OutputStream'+-- of strict 'ByteString's.+--+-- Note that the wrapped handle is /not/ closed when it receives+-- end-of-stream; you can use+-- 'System.IO.Streams.Combinators.atEndOfOutput' to close the handle+-- if you would like this behaviour.+--+-- /Note/: to force the 'Handle' to be flushed, you can write a null string to+-- the returned 'OutputStream':+--+-- > Streams.write (Just "") os+--+-- /Since: 1.3.4.0./+handleToStreams :: Handle+ -> IO (InputStream ByteString, OutputStream ByteString)+handleToStreams h = do+ is <- handleToInputStream h+ os <- handleToOutputStream h+ return $! (is, os)+++------------------------------------------------------------------------------ -- | Converts an 'InputStream' over bytestrings to a read-only 'Handle'. Note -- that the generated handle is opened unbuffered in binary mode (i.e. no -- newline translation is performed).@@ -87,11 +116,12 @@ -- that the 'Handle' will be opened in non-buffering mode; if you buffer the -- 'OutputStream' using the 'Handle' buffering then @io-streams@ will copy the -- 'Handle' buffer when sending 'ByteString' values to the output, which might--- not be what you want. When the output buffer, if used, is flushed, an empty--- string is written to the output, as is conventional throughout the--- @io-streams@ library for 'ByteString' output buffers.+-- not be what you want. ----- Note: the 'OutputStream' passed into this function is wrapped in+-- When the output buffer, if used, is flushed (using 'System.IO.hFlush'), an+-- empty string is written to the provided 'OutputStream'.+--+-- /Note/: the 'OutputStream' passed into this function is wrapped in -- 'lockingOutputStream' to make it thread-safe. -- -- /Since: 1.0.2.0./
src/System/IO/Streams/Internal.hs view
@@ -4,6 +4,7 @@ -- Library users should use the interface provided by "System.IO.Streams" {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}@@ -27,6 +28,7 @@ , unRead , peek , write+ , writeTo , atEOF -- * Building streams@@ -61,7 +63,9 @@ ) where ------------------------------------------------------------------------------+#if !MIN_VERSION_base(4,8,0) import Control.Applicative (Applicative (..), (<$>))+#endif import Control.Concurrent (newMVar, withMVar) import Control.Exception (throwIO) import Control.Monad (when)@@ -149,6 +153,15 @@ ------------------------------------------------------------------------------+-- | Flipped version of 'write'.+--+-- /Since: 1.3.0.0./+writeTo :: OutputStream a -> Maybe a -> IO ()+writeTo = _write+{-# INLINE writeTo #-}+++------------------------------------------------------------------------------ -- | Observes the first value from an 'InputStream' without consuming it. -- -- Returns 'Nothing' if the 'InputStream' is empty. 'peek' satisfies the@@ -429,37 +442,50 @@ ------------------------------------------------------------------------------+#if MIN_VERSION_base(4,15,0)+ignoreOffset :: (a -> ptr -> n -> ioint) -> a -> ptr -> off -> n -> ioint+ignoreOffset f a ptr _ n = f a ptr n+#else+ignoreOffset :: a -> a+ignoreOffset = id+#endif+{-# INLINE ignoreOffset #-}++------------------------------------------------------------------------------+-- | The offset argument is ignored if present. instance H.RawIO (InputStream ByteString) where- read is ptr n = read is >>= maybe (return 0) f- where- f s = S.unsafeUseAsCStringLen s $ \(cstr, l) -> do+ read = ignoreOffset $ \is ptr n ->+ let f s = S.unsafeUseAsCStringLen s $ \(cstr, l) -> do let c = min n l copyBytes ptr (castPtr cstr) c return $! c+ in read is >>= maybe (return 0) f - readNonBlocking _ _ _ = unsupported- write _ _ _ = unsupported- writeNonBlocking _ _ _ = unsupported+ readNonBlocking = ignoreOffset $ \_ _ _ -> unsupported+ write = ignoreOffset $ \_ _ _ -> unsupported+ writeNonBlocking = ignoreOffset $ \_ _ _ -> unsupported ------------------------------------------------------------------------------+-- | The offset argument is ignored if present. instance H.RawIO (OutputStream ByteString) where- read _ _ _ = unsupported- readNonBlocking _ _ _ = unsupported- write os ptr n = S.packCStringLen (castPtr ptr, n) >>=- flip write os . Just- writeNonBlocking _ _ _ = unsupported+ read = ignoreOffset $ \_ _ _ -> unsupported+ readNonBlocking = ignoreOffset $ \_ _ _ -> unsupported+ write = ignoreOffset $ \os ptr n -> S.packCStringLen (castPtr ptr, n) >>=+ flip write os . Just+ writeNonBlocking = ignoreOffset $ \_ _ _ -> unsupported ------------------------------------------------------------------------------ -- | Internal convenience synonym for a pair of input\/output streams. type StreamPair a = SP (InputStream a) (OutputStream a) +-- | The offset argument is ignored if present. instance H.RawIO (StreamPair ByteString) where- read (SP is _) ptr n = H.read is ptr n- readNonBlocking _ _ _ = unsupported- write (SP _ os) ptr n = H.write os ptr n- writeNonBlocking _ _ _ = unsupported+ read (SP is _) = H.read is+ readNonBlocking = ignoreOffset $ \_ _ _ -> unsupported+ write (SP _ os) = H.write os+ writeNonBlocking = ignoreOffset $ \_ _ _ -> unsupported ------------------------------------------------------------------------------
src/System/IO/Streams/Internal/Attoparsec.hs view
@@ -1,26 +1,35 @@ -- | This module provides support for parsing values from 'InputStream's using -- @attoparsec@. +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} module System.IO.Streams.Internal.Attoparsec ( -- * Parsing- ParseException(..)- , parseFromStream- , parseFromStreamInternal- , parserToInputStream+ parseFromStreamInternal++ , ParseData(..)++ -- * Parse Exceptions+ , ParseException(..)++ , eitherResult ) where ------------------------------------------------------------------------------ import Control.Exception (Exception, throwIO)-import Control.Monad (when)-import Data.Attoparsec.ByteString.Char8 (Parser, Result, eitherResult, feed, parse)-import Data.Attoparsec.Types (IResult (..))-import Data.ByteString.Char8 (ByteString)-import qualified Data.ByteString.Char8 as S+import Control.Monad (unless)+import qualified Data.Attoparsec.ByteString.Char8 as S+import qualified Data.Attoparsec.Text as T+import Data.Attoparsec.Types (IResult (..), Parser)+import qualified Data.ByteString as S+import Data.List (intercalate)+import Data.String (IsString)+import qualified Data.Text as T import Data.Typeable (Typeable)-import Prelude hiding (read)+import Prelude hiding (null, read) ------------------------------------------------------------------------------ import System.IO.Streams.Internal (InputStream) import qualified System.IO.Streams.Internal as Streams@@ -36,48 +45,45 @@ instance Exception ParseException + --------------------------------------------------------------------------------- | Supplies an @attoparsec@ 'Parser' with an 'InputStream', returning the--- final parsed value or a 'ParseException' if parsing fails.------ 'parseFromStream' consumes only as much input as necessary to satisfy the--- 'Parser' and unconsumed input is pushed back onto the 'InputStream'.------ If the 'Parser' exhausts the 'InputStream', it receives an @EOF@.------ Example:------ @--- ghci> import "Data.Attoparsec.ByteString.Char8"--- ghci> is <- 'System.IO.Streams.fromList' [\"12345xxx\" :: 'ByteString']--- ghci> 'parseFromStream' ('Data.Attoparsec.ByteString.Char8.takeWhile' 'Data.Attoparsec.ByteString.Char8.isDigit') is--- \"12345\"--- ghci> 'System.IO.Streams.read' is--- Just \"xxx\"--- @-parseFromStream :: Parser r- -> InputStream ByteString- -> IO r-parseFromStream = parseFromStreamInternal parse feed-{-# INLINE parseFromStream #-}+class (IsString i) => ParseData i where+ parse :: Parser i a -> i -> IResult i a+ feed :: IResult i r -> i -> IResult i r+ null :: i -> Bool ------------------------------------------------------------------------------+instance ParseData S.ByteString where+ parse = S.parse+ feed = S.feed+ null = S.null+++------------------------------------------------------------------------------+instance ParseData T.Text where+ parse = T.parse+ feed = T.feed+ null = T.null+++------------------------------------------------------------------------------ -- | Internal version of parseFromStream allowing dependency injection of the -- parse functions for testing.-parseFromStreamInternal :: (Parser r -> ByteString -> Result r)- -> (Result r -> ByteString -> Result r)- -> Parser r- -> InputStream ByteString+parseFromStreamInternal :: ParseData i+ => (Parser i r -> i -> IResult i r)+ -> (IResult i r -> i -> IResult i r)+ -> Parser i r+ -> InputStream i -> IO r parseFromStreamInternal parseFunc feedFunc parser is = Streams.read is >>= maybe (finish $ parseFunc parser "")- (\s -> if S.null s+ (\s -> if null s then parseFromStreamInternal parseFunc feedFunc parser is else go $! parseFunc parser s) where- leftover x = when (not $ S.null x) $ Streams.unRead x is+ leftover x = unless (null x) $ Streams.unRead x is finish k = let k' = feedFunc (feedFunc k "") "" in case k' of@@ -85,46 +91,25 @@ Partial _ -> err k' -- should be impossible Done x r -> leftover x >> return r - err r = let (Left s) = eitherResult r in throwIO $ ParseException s+ err r = let (Left (!_,c,m)) = eitherResult r+ in throwIO $ ParseException (ctxMsg c ++ m) + ctxMsg [] = ""+ ctxMsg xs = "[parsing " ++ intercalate "/" xs ++ "] "+ go r@(Fail x _ _) = leftover x >> err r go (Done x r) = leftover x >> return r go r = Streams.read is >>= maybe (finish r)- (\s -> if S.null s+ (\s -> if null s then go r else go $! feedFunc r s) --------------------------------------------------------------------------------- | Given a 'Parser' yielding values of type @'Maybe' r@, transforms an--- 'InputStream' over byte strings to an 'InputStream' yielding values of type--- @r@.------ If the parser yields @Just x@, then @x@ will be passed along downstream, and--- if the parser yields @Nothing@, that will be interpreted as end-of-stream.------ Upon a parse error, 'parserToInputStream' will throw a 'ParseException'.------ Example:------ @--- ghci> import "Control.Applicative"--- ghci> import "Data.Attoparsec.ByteString.Char8"--- ghci> is <- 'System.IO.Streams.fromList' [\"1 2 3 4 5\" :: 'ByteString']--- ghci> let parser = ('Data.Attoparsec.ByteString.Char8.endOfInput' >> 'Control.Applicative.pure' 'Nothing') \<|\> (Just \<$\> ('Data.Attoparsec.ByteString.Char8.skipWhile' 'Data.Attoparsec.ByteString.Char8.isSpace' *> 'Data.Attoparsec.ByteString.Char8.decimal'))--- ghci> 'parserToInputStream' parser is >>= 'System.IO.Streams.toList'--- [1,2,3,4,5]--- ghci> is' \<- 'System.IO.Streams.fromList' [\"1 2xx3 4 5\" :: 'ByteString'] >>= 'parserToInputStream' parser--- ghci> 'read' is'--- Just 1--- ghci> 'read' is'--- Just 2--- ghci> 'read' is'--- *** Exception: Parse exception: Failed reading: takeWhile1--- @-parserToInputStream :: Parser (Maybe r)- -> InputStream ByteString- -> IO (InputStream r)-parserToInputStream = (Streams.makeInputStream .) . parseFromStream-{-# INLINE parserToInputStream #-}+-- A replacement for attoparsec's 'eitherResult', which discards information+-- about the context of the failed parse.+eitherResult :: IsString i => IResult i r -> Either (i, [String], String) r+eitherResult (Done _ r) = Right r+eitherResult (Fail residual ctx msg) = Left (residual, ctx, msg)+eitherResult _ = Left ("", [], "Result: incomplete input")
src/System/IO/Streams/List.hs view
@@ -11,6 +11,7 @@ -- * Utility , chunkList+ , chunkListWith , concatLists , listOutputStream ) where@@ -154,6 +155,38 @@ finish = let l = dl [] in if null l then return $! () else yield l chunk x = go (k - 1) (dl . (x:))+++------------------------------------------------------------------------------+-- | Splits an input stream into chunks whenever @p elt count@ returns true.+--+-- Example:+--+-- @+-- ghci> 'fromList' [1..14::Int] >>= 'chunkListWith' (\x n -> n>=4) >>= 'toList'+-- [[1,2,3,4],[5,6,7,8],[9,10,11,12],[13,14]]+-- ghci> 'fromList' ['a'..'z'] >>= 'chunkListWith' (\x n -> n>=4 && x `elem` "aeiouy") >>= 'toList'+-- ["abcde","fghi","jklmno","pqrstu","vwxy","z"]+-- @+--+-- /Since: 1.3.3.0./+chunkListWith :: (a -> Int -> Bool) -- ^ break predicate+ -> InputStream a -- ^ stream to process+ -> IO (InputStream [a])+chunkListWith p input =+ fromGenerator $ go Nothing 0 id+ where+ go v !k dl+ | Just x <- v, p x k = yield (dl []) >> go Nothing 0 id+ | otherwise = do+ liftIO (read input) >>= maybe finish chunk+ where+ finish =+ let l = dl []+ in if null l+ then return $! ()+ else yield l+ chunk x = go (Just x) (k + 1) (dl . (x :)) ------------------------------------------------------------------------------
src/System/IO/Streams/Text.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-} -- | Stream primitives for decoding and encoding 'Text' values in UTF-8 format. module System.IO.Streams.Text@@ -14,7 +15,9 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as S import qualified Data.ByteString.Unsafe as S+#if !MIN_VERSION_base(4,8,0) import Data.Monoid (mappend)+#endif import Data.Text (Text) import qualified Data.Text.Encoding as T import Data.Text.Encoding.Error (OnDecodeError)
src/System/IO/Streams/Vector.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE CPP #-} -- | Vector conversions and utilities. @@ -29,7 +30,7 @@ import Control.Concurrent.MVar (modifyMVar, modifyMVar_, newMVar) import Control.Monad (liftM, (>=>)) import Control.Monad.IO.Class (MonadIO (..))-import Control.Monad.Primitive (PrimState (..))+import Control.Monad.Primitive (PrimState (..), RealWorld) import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.Vector.Generic (Vector (..)) import qualified Data.Vector.Generic as V@@ -38,7 +39,17 @@ import System.IO.Streams.Internal (InputStream, OutputStream, fromGenerator, yield) import qualified System.IO.Streams.Internal as S +#if MIN_VERSION_vector(0,13,0)+import Control.Monad.ST (stToIO)+#endif +basicUnsafeFreezeCompat :: Vector v a => V.Mutable v RealWorld a -> IO (v a)+#if MIN_VERSION_vector(0,13,0)+basicUnsafeFreezeCompat = stToIO . V.basicUnsafeFreeze+#else+basicUnsafeFreezeCompat = V.basicUnsafeFreeze+#endif+ ------------------------------------------------------------------------------ -- | Transforms a vector into an 'InputStream' that yields each of the values -- in the vector in turn.@@ -77,7 +88,7 @@ -- | Like 'toVector', but allows control over how large the vector buffer is to -- start with. toVectorSized :: Vector v a => Int -> InputStream a -> IO (v a)-toVectorSized n = toMutableVectorSized n >=> V.basicUnsafeFreeze+toVectorSized n = toMutableVectorSized n >=> basicUnsafeFreezeCompat {-# INLINE toVectorSized #-} @@ -136,7 +147,7 @@ vectorOutputStreamSized :: Vector v c => Int -> IO (OutputStream c, IO (v c)) vectorOutputStreamSized n = do (os, flush) <- mutableVectorOutputStreamSized n- return $! (os, flush >>= V.basicUnsafeFreeze)+ return $! (os, flush >>= basicUnsafeFreezeCompat) ------------------------------------------------------------------------------@@ -291,7 +302,7 @@ Int -> (OutputStream a -> IO b) -> IO (v a)-outputToVectorSized n = outputToMutableVectorSized n >=> V.basicUnsafeFreeze+outputToVectorSized n = outputToMutableVectorSized n >=> basicUnsafeFreezeCompat {-# INLINE outputToVectorSized #-}
src/System/IO/Streams/Zlib.hs view
@@ -18,18 +18,18 @@ ) where -------------------------------------------------------------------------------import Data.ByteString (ByteString)-import qualified Data.ByteString as S-import Data.IORef (newIORef, readIORef, writeIORef)-import Prelude hiding (read)+import Data.ByteString (ByteString)+import qualified Data.ByteString as S+import Data.IORef (newIORef, readIORef, writeIORef)+import Prelude hiding (read) -------------------------------------------------------------------------------import Blaze.ByteString.Builder (fromByteString)-import Blaze.ByteString.Builder.Internal (Builder, defaultBufferSize, flush)-import Blaze.ByteString.Builder.Internal.Buffer (allocBuffer)-import Codec.Zlib (Deflate, Inflate, Popper, WindowBits (..), feedDeflate, feedInflate, finishDeflate, finishInflate, flushDeflate, flushInflate, initDeflate, initInflate)+import Codec.Zlib (Deflate, Inflate, Popper, WindowBits (..), feedDeflate, feedInflate, finishDeflate, finishInflate, flushDeflate, flushInflate, initDeflate, initInflate)+import Data.ByteString.Builder (Builder, byteString)+import Data.ByteString.Builder.Extra (defaultChunkSize, flush)+import Data.ByteString.Builder.Internal (newBuffer) -------------------------------------------------------------------------------import System.IO.Streams.Builder (unsafeBuilderStream)-import System.IO.Streams.Internal (InputStream, OutputStream, makeInputStream, makeOutputStream, read, write)+import System.IO.Streams.Builder (unsafeBuilderStream)+import System.IO.Streams.Internal (InputStream, OutputStream, makeInputStream, makeOutputStream, read, write) ------------------------------------------------------------------------------@@ -105,13 +105,13 @@ -- we can use unsafeBuilderStream here because zlib is going to consume the -- stream- unsafeBuilderStream (allocBuffer defaultBufferSize) zippedStr+ unsafeBuilderStream (newBuffer defaultChunkSize) zippedStr where bytestringStream x = write (fmap cvt x) stream cvt s | S.null s = flush- | otherwise = fromByteString s+ | otherwise = byteString s ------------------------------------------------------------------------------
− test/System/IO/Streams/Tests/Attoparsec.hs
@@ -1,111 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module System.IO.Streams.Tests.Attoparsec (tests) where---------------------------------------------------------------------------------import Control.Monad-import Data.Attoparsec.ByteString.Char8-import Data.ByteString.Char8 (ByteString)-import Prelude hiding (takeWhile)-import System.IO.Streams-import System.IO.Streams.Internal.Attoparsec-import System.IO.Streams.Tests.Common-import Test.Framework-import Test.Framework.Providers.HUnit-import Test.HUnit hiding (Test)---------------------------------------------------------------------------------tests :: [Test]-tests = [ testParseFromStream- , testParseFromStreamError- , testParseFromStreamError2- , testPartialParse- , testEmbeddedNull- , testTrivials- ]----------------------------------------------------------------------------------testParser :: Parser (Maybe Int)-testParser = do- end <- atEnd- if end- then return Nothing- else do- _ <- takeWhile (\c -> isSpace c || c == ',')- liftM Just decimal----------------------------------------------------------------------------------testParser2 :: Parser (Maybe ByteString)-testParser2 = do- end <- atEnd- if end- then return Nothing- else liftM Just $ string "bork"----------------------------------------------------------------------------------testParseFromStream :: Test-testParseFromStream = testCase "attoparsec/parseFromStream" $ do- is <- fromList ["1", "23", ", 4", ", 5, 6, 7"]- x0 <- parseFromStream testParser is-- assertEqual "first parse" (Just 123) x0-- l <- parserToInputStream testParser is >>= toList-- assertEqual "rest" [4, 5, 6, 7] l- toList is >>= assertEqual "double eof" []----------------------------------------------------------------------------------testParseFromStreamError :: Test-testParseFromStreamError = testCase "attoparsec/parseFromStreamError" $ do- is <- fromList ["1", "23", ", 4", ",xxxx 5, 6, 7"] >>=- parserToInputStream testParser-- expectExceptionH $ toList is----------------------------------------------------------------------------------testParseFromStreamError2 :: Test-testParseFromStreamError2 = testCase "attoparsec/parseFromStreamError2" $ do- l <- fromList ["borkbork", "bork"] >>= p- assertEqual "ok" ["bork", "bork", "bork"] l-- expectExceptionH $ fromList ["bork", "bo"] >>= p- expectExceptionH $ fromList ["xxxxx"] >>= p-- where- p = parserToInputStream testParser2 >=> toList----------------------------------------------------------------------------------testPartialParse :: Test-testPartialParse = testCase "attoparsec/partialParse" $ do- is <- fromList ["1,", "2,", "3"]- expectExceptionH $ parseFromStreamInternal parseFunc feedFunc testParser is-- where- result = Partial (const result)- parseFunc = const $ const $ result- feedFunc = const $ const $ result---------------------------------------------------------------------------------testTrivials :: Test-testTrivials = testCase "attoparsec/trivials" $ do- coverTypeableInstance (undefined :: ParseException)----------------------------------------------------------------------------------testEmbeddedNull :: Test-testEmbeddedNull = testCase "attoparsec/embeddedNull" $ do- is <- fromList ["", "1", "23", "", ", 4", ", 5, 6, 7"]- x0 <- parseFromStream testParser is-- assertEqual "first parse" (Just 123) x0-- l <- parserToInputStream testParser is >>= toList-- assertEqual "rest" [4, 5, 6, 7] l
+ test/System/IO/Streams/Tests/Attoparsec/ByteString.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE OverloadedStrings #-}++module System.IO.Streams.Tests.Attoparsec.ByteString (tests) where++------------------------------------------------------------------------------+import Control.Monad+import Data.Attoparsec.ByteString.Char8 hiding (eitherResult)+import Data.ByteString.Char8 (ByteString)+import Prelude hiding (takeWhile)+import System.IO.Streams+import System.IO.Streams.Attoparsec.ByteString+import System.IO.Streams.Internal.Attoparsec (eitherResult, parseFromStreamInternal)+import System.IO.Streams.Tests.Common+import Test.Framework+import Test.Framework.Providers.HUnit+import Test.HUnit hiding (Test)+------------------------------------------------------------------------------++tests :: [Test]+tests = [ testParseFromStream+ , testParseFromStreamError+ , testParseFromStreamError2+ , testPartialParse+ , testEmbeddedNull+ , testTrivials+ ]+++------------------------------------------------------------------------------+testParser :: Parser (Maybe Int)+testParser = do+ end <- atEnd+ if end+ then return Nothing+ else do+ _ <- takeWhile (\c -> isSpace c || c == ',')+ liftM Just decimal+++------------------------------------------------------------------------------+testParser2 :: Parser (Maybe ByteString)+testParser2 = do+ end <- atEnd+ if end+ then return Nothing+ else liftM Just $ string "bork"+++------------------------------------------------------------------------------+testParseFromStream :: Test+testParseFromStream = testCase "attoparsec/parseFromStream" $ do+ is <- fromList ["1", "23", ", 4", ", 5, 6, 7"]+ x0 <- parseFromStream testParser is++ assertEqual "first parse" (Just 123) x0++ l <- parserToInputStream testParser is >>= toList++ assertEqual "rest" [4, 5, 6, 7] l+ toList is >>= assertEqual "double eof" []+++------------------------------------------------------------------------------+testParseFromStreamError :: Test+testParseFromStreamError = testCase "attoparsec/parseFromStreamError" $ do+ is <- fromList ["1", "23", ", 4", ",xxxx 5, 6, 7"] >>=+ parserToInputStream testParser++ expectExceptionH $ toList is+++------------------------------------------------------------------------------+testParseFromStreamError2 :: Test+testParseFromStreamError2 = testCase "attoparsec/parseFromStreamError2" $ do+ l <- fromList ["borkbork", "bork"] >>= p+ assertEqual "ok" ["bork", "bork", "bork"] l++ expectExceptionH $ fromList ["bork", "bo"] >>= p+ expectExceptionH $ fromList ["xxxxx"] >>= p++ where+ p = parserToInputStream ((testParser2 <?> "foo") <?> "bar") >=> toList+++------------------------------------------------------------------------------+testPartialParse :: Test+testPartialParse = testCase "attoparsec/partialParse" $ do+ is <- fromList ["1,", "2,", "3"]+ expectExceptionH $ parseFromStreamInternal parseFunc feedFunc testParser is++ where+ result = Partial (const result)+ parseFunc = const $ const $ result+ feedFunc = const $ const $ result++------------------------------------------------------------------------------+testTrivials :: Test+testTrivials = testCase "attoparsec/trivials" $ do+ coverTypeableInstance (undefined :: ParseException)+ let (Right x) = eitherResult $ Done undefined 4 :: Either (ByteString, [String], String) Int+ assertEqual "eitherResult" 4 x++------------------------------------------------------------------------------+testEmbeddedNull :: Test+testEmbeddedNull = testCase "attoparsec/embeddedNull" $ do+ is <- fromList ["", "1", "23", "", ", 4", ", 5, 6, 7"]+ x0 <- parseFromStream testParser is++ assertEqual "first parse" (Just 123) x0++ l <- parserToInputStream testParser is >>= toList++ assertEqual "rest" [4, 5, 6, 7] l
+ test/System/IO/Streams/Tests/Attoparsec/Text.hs view
@@ -0,0 +1,140 @@+{-# LANGUAGE OverloadedStrings #-}++module System.IO.Streams.Tests.Attoparsec.Text (tests, testParserU) where++------------------------------------------------------------------------------+import Control.Monad+import Data.Attoparsec.Text hiding (eitherResult)+import Data.Char (isAlpha, isSpace)+import Data.Text (Text)+import Prelude hiding (takeWhile)+import System.IO.Streams+import System.IO.Streams.Attoparsec.Text+import System.IO.Streams.Internal.Attoparsec (eitherResult, parseFromStreamInternal)+import System.IO.Streams.Tests.Common+import Test.Framework+import Test.Framework.Providers.HUnit+import Test.HUnit hiding (Test)+------------------------------------------------------------------------------++tests :: [Test]+tests = [ testParseFromStream+ , testParseFromStreamError+ , testParseFromStreamError2+ , testPartialParse+ , testEmbeddedNull+ , testTrivials+ , testParseFromStreamU+ ]+++------------------------------------------------------------------------------+testParser :: Parser (Maybe Int)+testParser = do+ end <- atEnd+ if end+ then return Nothing+ else do+ _ <- takeWhile (\c -> isSpace c || c == ',')+ liftM Just decimal+++------------------------------------------------------------------------------+testParser2 :: Parser (Maybe Text)+testParser2 = do+ end <- atEnd+ if end+ then return Nothing+ else liftM Just $ string "bork"+++------------------------------------------------------------------------------+testParserU :: Parser (Maybe Text)+testParserU = do+ end <- atEnd+ if end+ then return Nothing+ else do+ _ <- takeWhile (not . isAlpha)+ liftM Just (takeWhile isAlpha)+++------------------------------------------------------------------------------+testParseFromStream :: Test+testParseFromStream = testCase "attoparsec/parseFromStream" $ do+ is <- fromList ["1", "23", ", 4", ", 5, 6, 7"]+ x0 <- parseFromStream testParser is++ assertEqual "first parse" (Just 123) x0++ l <- parserToInputStream testParser is >>= toList++ assertEqual "rest" [4, 5, 6, 7] l+ toList is >>= assertEqual "double eof" []+++------------------------------------------------------------------------------+testParseFromStreamError :: Test+testParseFromStreamError = testCase "attoparsec/parseFromStreamError" $ do+ is <- fromList ["1", "23", ", 4", ",xxxx 5, 6, 7"] >>=+ parserToInputStream testParser++ expectExceptionH $ toList is+++------------------------------------------------------------------------------+testParseFromStreamError2 :: Test+testParseFromStreamError2 = testCase "attoparsec/parseFromStreamError2" $ do+ l <- fromList ["borkbork", "bork"] >>= p+ assertEqual "ok" ["bork", "bork", "bork"] l++ expectExceptionH $ fromList ["bork", "bo"] >>= p+ expectExceptionH $ fromList ["xxxxx"] >>= p++ where+ p = parserToInputStream ((testParser2 <?> "foo") <?> "bar") >=> toList+++------------------------------------------------------------------------------+testPartialParse :: Test+testPartialParse = testCase "attoparsec/partialParse" $ do+ is <- fromList ["1,", "2,", "3"]+ expectExceptionH $ parseFromStreamInternal parseFunc feedFunc testParser is++ where+ result = Partial (const result)+ parseFunc = const $ const $ result+ feedFunc = const $ const $ result++------------------------------------------------------------------------------+testTrivials :: Test+testTrivials = testCase "attoparsec/trivials" $ do+ coverTypeableInstance (undefined :: ParseException)+ let (Right x) = eitherResult $ Done undefined 4 :: Either (Text, [String], String) Int+ assertEqual "eitherResult" 4 x++------------------------------------------------------------------------------+testEmbeddedNull :: Test+testEmbeddedNull = testCase "attoparsec/embeddedNull" $ do+ is <- fromList ["", "1", "23", "", ", 4", ", 5, 6, 7"]+ x0 <- parseFromStream testParser is++ assertEqual "first parse" (Just 123) x0++ l <- parserToInputStream testParser is >>= toList++ assertEqual "rest" [4, 5, 6, 7] l++------------------------------------------------------------------------------+testParseFromStreamU :: Test+testParseFromStreamU = testCase "attoparsec/parseFromStreamU" $ do+ is <- fromList ["123æø", "å", "💻⛇⛄☃Š", "š5ŧđ6naå7"]+ x0 <- parseFromStream testParserU is++ assertEqual "first parse" (Just "æøå") x0++ l <- parserToInputStream testParserU is >>= toList++ assertEqual "rest" ["Šš", "ŧđ", "naå", ""] l+ toList is >>= assertEqual "double eof" []+
test/System/IO/Streams/Tests/Builder.hs view
@@ -3,17 +3,19 @@ module System.IO.Streams.Tests.Builder (tests) where -------------------------------------------------------------------------------import Blaze.ByteString.Builder-import Blaze.ByteString.Builder.Internal.Buffer import Control.Monad-import qualified Data.ByteString.Char8 as S+import Data.ByteString.Builder (byteString, toLazyByteString)+import Data.ByteString.Builder.Extra (flush)+import Data.ByteString.Builder.Internal (newBuffer)+import qualified Data.ByteString.Char8 as S+import qualified Data.ByteString.Lazy.Char8 as L import Data.List import Data.Monoid-import System.IO.Streams hiding (fromByteString, intersperse, map, take)-import qualified System.IO.Streams as Streams+import System.IO.Streams hiding (intersperse, map, take)+import qualified System.IO.Streams as Streams import Test.Framework import Test.Framework.Providers.HUnit-import Test.HUnit hiding (Test)+import Test.HUnit hiding (Test) ------------------------------------------------------------------------------ tests :: [Test]@@ -31,7 +33,7 @@ testBuilderStream = testCase "builder/builderStream" $ do let l1 = intersperse " " ["the", "quick", "brown", "fox"] let l2 = intersperse " " ["jumped", "over", "the"]- let l = map fromByteString l1 ++ [flush] ++ map fromByteString l2+ let l = map byteString l1 ++ [flush] ++ map byteString l2 is <- fromList l (os0, grab) <- listOutputStream@@ -53,9 +55,9 @@ (os0, grab) <- Streams.listOutputStream os <- Streams.builderStream os0 is0 <- Streams.fromList ["Hello, world!\n"]- >>= Streams.map fromByteString+ >>= Streams.map byteString is1 <- Streams.fromList ["Bye, world!\n"]- >>= Streams.map fromByteString+ >>= Streams.map byteString Streams.connect is0 os Streams.connect is1 os Streams.write Nothing os@@ -68,13 +70,13 @@ testUnsafeBuilderStream = testCase "builder/unsafeBuilderStream" $ do let l1 = intersperse " " ["the", "quick", "brown", "fox"] let l2 = intersperse " " ["jumped", "over", "the"]- let l = map fromByteString l1 ++ [flush] ++ map fromByteString l2+ let l = map byteString l1 ++ [flush] ++ map byteString l2 is <- fromList l (os0, grab) <- listOutputStream os1 <- contramapM (return . S.copy) os0 - os <- unsafeBuilderStream (allocBuffer 1024) os1+ os <- unsafeBuilderStream (newBuffer 1024) os1 connect is os output <- grab@@ -89,11 +91,11 @@ testSmallBuffer :: Test testSmallBuffer = testCase "builder/smallBuffer" $ do (os0, grab) <- listOutputStream- os <- builderStreamWith (allNewBuffersStrategy 10) os0+ os <- builderStreamWithBufferSize 10 os0 let l1 = intersperse " " ["the", "quick", "brown"] let l2 = [" fooooooooooooooooox"]- let l = map fromByteString l1 ++ [flush, flush, flush]- ++ map fromByteString l2+ let l = map byteString l1 ++ [flush, flush, flush]+ ++ map byteString l2 is <- fromList l connect is os@@ -108,20 +110,20 @@ testCase "builder/smallBufferWithLargeOutput" $ do (os0, grab) <- listOutputStream os1 <- contramapM (return . S.copy) os0- os <- unsafeBuilderStream (allocBuffer 10) os1+ os <- unsafeBuilderStream (newBuffer 10) os1 let l = take 3000 $ cycle $- replicate 20 (fromByteString "bloooooooort") ++ [flush]+ replicate 20 (byteString "bloooooooort") ++ [flush] is <- fromList l- let s = toByteString $ mconcat l+ let s = S.concat $ L.toChunks $ toLazyByteString $ mconcat l connect is os output <- liftM S.concat grab assertEqual "short buffer 2" s output - write (Just $ fromByteString "ok") os+ write (Just $ byteString "ok") os write Nothing os fout <- grab
test/System/IO/Streams/Tests/ByteString.hs view
@@ -8,18 +8,12 @@ import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as S import qualified Data.ByteString.Lazy.Char8 as L-import Data.List hiding (lines,- takeWhile, unlines,- unwords, words)+import Data.List hiding (lines, takeWhile, unlines, unwords, words) import Data.Maybe (isJust) import Data.Monoid-import Prelude hiding (lines, read,- takeWhile, unlines,- unwords, unwords,- words)+import Prelude hiding (lines, read, take, takeWhile, unlines, unwords, words) import qualified Prelude-import System.IO.Streams hiding (filter,- intersperse, mapM_)+import System.IO.Streams hiding (filter, intersperse, mapM_) import System.IO.Streams.Tests.Common import System.Timeout import Test.Framework@@ -625,6 +619,8 @@ fromList ["th", "e\nquick\nbrown", "\n", "", "fox"] >>= lines >>= toList >>= assertEqual "lines" ["the", "quick", "brown", "fox"] fromList [] >>= lines >>= toList >>= assertEqual "empty lines" []+ fromList ["a\nb\nc\n"] >>= lines >>= toList+ >>= assertEqual "ending in delimiter" ["a","b","c"] fromList ["ok", "cool"] >>= \is -> outputToList (\os -> unlines os >>= connect is) >>=
test/System/IO/Streams/Tests/Combinators.hs view
@@ -40,18 +40,23 @@ , testFoldMWorksTwice , testFold , testFoldM+ , testFold_+ , testFoldM_ , testUnfoldM , testPredicates , testMap , testContramap , testMapM , testMapM_+ , testMapMaybe , testContramapM_+ , testContramapMaybe , testSkipToEof , testZip , testZipWith , testZipWithM , testUnzip+ , testContraunzip , testTake , testDrop , testGive@@ -128,6 +133,15 @@ ------------------------------------------------------------------------------+testMapMaybe :: Test+testMapMaybe = testCase "combinators/mapMaybe" $ do+ is <- fromList [1,2,3::Int] >>= S.mapMaybe (\x -> if odd x then Just (x * x) else Nothing)+ l <- toList is++ assertEqual "mapMaybe" [1,9] l+++------------------------------------------------------------------------------ testContramapM_ :: Test testContramapM_ = testCase "combinators/contramapM_" $ do ref <- newIORef 0@@ -138,6 +152,15 @@ ------------------------------------------------------------------------------+testContramapMaybe :: Test+testContramapMaybe = testCase "combinators/contramapMaybe" $ do+ is <- fromList [1,2,3::Int]+ l <- outputToList (contramapMaybe f >=> connect is)+ assertEqual "contramapMaybe" [1,9] l+ where f x = if even x then Nothing else Just $ x * x+++------------------------------------------------------------------------------ testSkipToEof :: Test testSkipToEof = testCase "combinators/skipToEof" $ do is <- fromList [1,2,3::Int]@@ -215,6 +238,19 @@ ------------------------------------------------------------------------------+testFold_ :: Test+testFold_ = testCase "combinators/fold_" $ do+ fromList [1..10::Int] >>= S.fold_ (+) 0 id+ >>= assertEqual "fold_1" (sum [1..10])++------------------------------------------------------------------------------+testFoldM_ :: Test+testFoldM_ = testCase "combinators/foldM_" $ do+ fromList [1..10::Int] >>= S.foldM_ ((return .) . (+)) (return 0) return+ >>= assertEqual "fold_2" (sum [1..10])+++------------------------------------------------------------------------------ testUnfoldM :: Test testUnfoldM = testCase "combinators/unfoldM" $ do S.unfoldM gen 0 >>= toList >>= assertEqual "unfold" result@@ -323,6 +359,26 @@ toList is3 >>= assertEqual "unzip2-a" (fst $ Prelude.unzip l) read is4 >>= assertEqual "unzip2-read-b" Nothing read is3 >>= assertEqual "unzip2-read" Nothing+++------------------------------------------------------------------------------+testContraunzip :: Test+testContraunzip = testProperty "combinators/contrazip" $ monadicIO $ forAllM arbitrary prop+ where+ prop :: [Int] -> PropertyM IO ( )+ prop xs = liftQ $ do+ let ys = fmap show xs+ xsStream <- fromList xs+ ysStream <- fromList ys+ (xsSink, getXs') <- listOutputStream+ (ysSink, getYs') <- listOutputStream+ xysStream <- zip xsStream ysStream+ xysSink <- contraunzip xsSink ysSink+ connect xysStream xysSink+ xs' <- getXs'+ ys' <- getYs'+ assertEqual "numbers" xs xs'+ assertEqual "strings" ys ys' ------------------------------------------------------------------------------
test/System/IO/Streams/Tests/Concurrent.hs view
@@ -3,11 +3,7 @@ ------------------------------------------------------------------------------ import Control.Concurrent import Control.Monad-import Prelude hiding (lines, read,- takeWhile, unlines,- unwords, unwords,- words)-import qualified Prelude+import Prelude hiding (lines, read, takeWhile, unlines, unwords, unwords, words) import qualified System.IO.Streams as Streams import qualified System.IO.Streams.Concurrent as Streams import System.IO.Streams.Tests.Common@@ -51,7 +47,7 @@ chans inputs <- mapM Streams.chanToInput chans resultMVar <- newEmptyMVar- forkIO (Streams.concurrentMerge inputs >>= Streams.toList+ _ <- forkIO (Streams.concurrentMerge inputs >>= Streams.toList >>= putMVar resultMVar) putMVar firstMVar 0 result <- takeMVar resultMVar
test/System/IO/Streams/Tests/Handle.hs view
@@ -1,12 +1,13 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module System.IO.Streams.Tests.Handle (tests) where -------------------------------------------------------------------------------import Blaze.ByteString.Builder import Control.Exception import Control.Monad hiding (mapM)+import Data.ByteString.Builder (byteString) import qualified Data.ByteString.Char8 as S import Data.List import Foreign.Marshal.Alloc (allocaBytes)@@ -76,8 +77,8 @@ os0 <- Streams.handleToOutputStream h os <- Streams.builderStream os0 - let l1 = map fromByteString ["the ", "quick ", "brown "]- let l2 = map fromByteString ["fox ", "jumped"]+ let l1 = map byteString ["the ", "quick ", "brown "]+ let l2 = map byteString ["fox ", "jumped"] Streams.fromList l1 >>= Streams.connectTo os Streams.fromList l2 >>= Streams.connectTo os S.readFile fn >>= assertEqual "eof should close" "the quick brown "@@ -148,13 +149,13 @@ is <- Streams.fromList ["foo", "bar", "baz" :: S.ByteString] (os, getList) <- Streams.listOutputStream let sp = Streams.SP is (os :: OutputStream S.ByteString)- expectExceptionH $ H.write is undefined undefined- expectExceptionH $ H.writeNonBlocking is undefined undefined+ expectExceptionH $ withZeroOffset H.write is undefined undefined+ expectExceptionH $ withZeroOffset H.writeNonBlocking is undefined undefined expectExceptionH $ H.flushWriteBuffer is undefined expectExceptionH $ H.flushWriteBuffer0 is undefined - expectExceptionH $ H.read os undefined undefined- expectExceptionH $ H.writeNonBlocking os undefined undefined+ expectExceptionH $ withZeroOffset H.read os undefined undefined+ expectExceptionH $ withZeroOffset H.writeNonBlocking os undefined undefined expectExceptionH $ H.fillReadBuffer0 is undefined expectExceptionH $ H.fillReadBuffer0 os undefined@@ -168,17 +169,17 @@ H.devType os >>= assertBool "devtype output" . (== H.Stream) H.devType sp >>= assertBool "devtype pair" . (== H.Stream) - expectExceptionH $ H.readNonBlocking is undefined undefined- expectExceptionH $ H.readNonBlocking os undefined undefined- expectExceptionH $ H.readNonBlocking sp undefined undefined- expectExceptionH $ H.writeNonBlocking is undefined undefined- expectExceptionH $ H.writeNonBlocking os undefined undefined- expectExceptionH $ H.writeNonBlocking sp undefined undefined+ expectExceptionH $ withZeroOffset H.readNonBlocking is undefined undefined+ expectExceptionH $ withZeroOffset H.readNonBlocking os undefined undefined+ expectExceptionH $ withZeroOffset H.readNonBlocking sp undefined undefined+ expectExceptionH $ withZeroOffset H.writeNonBlocking is undefined undefined+ expectExceptionH $ withZeroOffset H.writeNonBlocking os undefined undefined+ expectExceptionH $ withZeroOffset H.writeNonBlocking sp undefined undefined S.useAsCStringLen "foo" $ \(cstr, l) -> do- H.write os (castPtr cstr) l+ withZeroOffset H.write os (castPtr cstr) l liftM S.concat getList >>= assertEqual "H.write 1" "foo"- H.write sp (castPtr cstr) l+ withZeroOffset H.write sp (castPtr cstr) l liftM S.concat getList >>= assertEqual "H.write 2" "foo" buf <- H.newBuffer sp HB.WriteBuffer HB.withBuffer buf $ \ptr -> copyBytes ptr (castPtr cstr) 3@@ -189,10 +190,18 @@ allocaBytes 3 $ \buf -> do- l <- H.read is buf 3+ l <- withZeroOffset H.read is buf 3 assertEqual "3 byte read" 3 l S.packCStringLen (castPtr buf, l) >>= assertEqual "first read" "foo"- l' <- H.read sp buf 3+ l' <- withZeroOffset H.read sp buf 3 assertEqual "3 byte read #2" 3 l' S.packCStringLen (castPtr buf, l') >>= assertEqual "second read" "bar"- expectExceptionH $ H.read os buf 3+ expectExceptionH $ withZeroOffset H.read os buf 3+ where+#if MIN_VERSION_base(4,15,0)+ withZeroOffset :: Num off => (a -> ptr -> off -> n -> ioint) -> a -> ptr -> n -> ioint+ withZeroOffset f a ptr n = f a ptr 0 n+#else+ withZeroOffset :: a -> a+ withZeroOffset = id+#endif
test/System/IO/Streams/Tests/List.hs view
@@ -14,9 +14,10 @@ import System.IO.Streams.Tests.Common (expectExceptionH) tests :: [Test]-tests = [ testChunkJoin ]+tests = [ testChunkJoin, testChunkWithJoin ] + testChunkJoin :: Test testChunkJoin = testCase "list/chunkList and join" $ do expectExceptionH (fromList [1..10::Int] >>= chunkList 0 >>= toList)@@ -32,3 +33,28 @@ >>= concatLists >>= toList >>= assertEqual "concatlists" [1..12]++testChunkWithJoin :: Test+testChunkWithJoin = testCase "list/chunkListWith and join" $ do+ fromList [1..10 :: Int] >>= chunkListWith (\_ n -> n>=3)+ >>= toList+ >>= assertEqual "chunkListWith" [ [1,2,3]+ , [4,5,6]+ , [7,8,9]+ , [10]+ ]+ fromList [1..12 :: Int] >>= chunkListWith (\_ n -> n>=3)+ >>= concatLists+ >>= toList+ >>= assertEqual "concatlists" [1..12]++ fromList ['a'..'z' :: Char]+ >>= chunkListWith (\x n -> n>=4 && x `elem` ("aeiouy" :: String))+ >>= toList+ >>= assertEqual "chunkListWith" [ "abcde"+ , "fghi"+ , "jklmno"+ , "pqrstu"+ , "vwxy"+ , "z"+ ]
test/System/IO/Streams/Tests/Network.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-} module System.IO.Streams.Tests.Network (tests) where @@ -13,6 +14,10 @@ import Test.Framework import Test.Framework.Providers.HUnit import Test.HUnit hiding (Test)+#if MIN_VERSION_network(2,7,0)+#else+import Data.List (intercalate)+#endif ------------------------------------------------------------------------------ import qualified System.IO.Streams.Internal as Streams import qualified System.IO.Streams.Internal.Network as Streams@@ -32,10 +37,23 @@ assertEqual "ok" (Just ()) x where+ -- compats+#if MIN_VERSION_network(2,7,0)+ mkAddr = return . N.tupleToHostAddress+ defaultPort = N.defaultPort+ close = N.close+ bind = N.bind+#else+ mkAddr (o1,o2,o3,o4) = N.inet_addr . intercalate "." $ map show [o1,o2,o3,o4]+ defaultPort = N.aNY_PORT+ close = N.sClose+ bind = N.bindSocket+#endif+ go = do portMVar <- newEmptyMVar resultMVar <- newEmptyMVar- forkIO $ client portMVar resultMVar+ _ <- forkIO $ client portMVar resultMVar server portMVar l <- takeMVar resultMVar assertEqual "testSocket" l ["ok"]@@ -43,28 +61,28 @@ client mvar resultMVar = do port <- takeMVar mvar sock <- N.socket N.AF_INET N.Stream N.defaultProtocol- addr <- N.inet_addr "127.0.0.1"+ addr <- mkAddr (127, 0, 0, 1) let saddr = N.SockAddrInet port addr N.connect sock saddr (is, os) <- Streams.socketToStreams sock Streams.fromList ["", "ok"] >>= Streams.connectTo os N.shutdown sock N.ShutdownSend Streams.toList is >>= putMVar resultMVar- N.sClose sock+ close sock server mvar = do sock <- N.socket N.AF_INET N.Stream N.defaultProtocol- addr <- N.inet_addr "127.0.0.1"- let saddr = N.SockAddrInet N.aNY_PORT addr- N.bindSocket sock saddr+ addr <- mkAddr (127, 0, 0, 1)+ let saddr = N.SockAddrInet defaultPort addr+ bind sock saddr N.listen sock 5 port <- N.socketPort sock putMVar mvar port (csock, _) <- N.accept sock (is, os) <- Streams.socketToStreams csock Streams.toList is >>= flip Streams.writeList os- N.sClose csock- N.sClose sock+ close csock+ close sock testSocketWithError :: Test testSocketWithError = testCase "network/socket-error" $ N.withSocketsDo $ do
test/System/IO/Streams/Tests/Process.hs view
@@ -40,7 +40,7 @@ ------------------------------------------------------------------------------ testInteractiveProcess :: Test testInteractiveProcess = testCase "process/interactiveProcess" $ do- (out, err) <- Streams.runInteractiveProcess "/usr/bin/tr" ["a-z", "A-Z"]+ (out, err) <- Streams.runInteractiveProcess "tr" ["a-z", "A-Z"] Nothing Nothing >>= run [inputdata] assertEqual "interactiveProcess" expected out
test/System/IO/Streams/Tests/Zlib.hs view
@@ -3,10 +3,11 @@ module System.IO.Streams.Tests.Zlib (tests) where -------------------------------------------------------------------------------import Blaze.ByteString.Builder import qualified Codec.Compression.GZip as GZ import qualified Codec.Compression.Zlib as Z import Control.Monad hiding (mapM)+import Data.ByteString.Builder (Builder, byteString)+import Data.ByteString.Builder.Extra (flush) import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as S import qualified Data.ByteString.Lazy.Char8 as L@@ -18,7 +19,7 @@ import Test.QuickCheck hiding (output) import Test.QuickCheck.Monadic -------------------------------------------------------------------------------import System.IO.Streams hiding (fromByteString)+import System.IO.Streams import System.IO.Streams.Tests.Common tests :: [Test]@@ -153,10 +154,10 @@ propBuilderFlush name inf comp a b = do pre (not (S.null a) && not (S.null b)) liftQ $ do- t 7 [ fromByteString a, flush, flush, fromByteString b+ t 7 [ byteString a, flush, flush, byteString b , flush, flush ] - t 4 [ fromByteString a, flush, flush, fromByteString b ]+ t 4 [ byteString a, flush, flush, byteString b ] where t expected input = do
test/TestSuite.hs view
@@ -1,28 +1,36 @@+{-# LANGUAGE CPP #-}+ module Main where -import qualified System.IO.Streams.Tests.Attoparsec as Attoparsec-import qualified System.IO.Streams.Tests.Builder as Builder-import qualified System.IO.Streams.Tests.ByteString as ByteString-import qualified System.IO.Streams.Tests.Combinators as Combinators-import qualified System.IO.Streams.Tests.Concurrent as Concurrent-import qualified System.IO.Streams.Tests.Debug as Debug-import qualified System.IO.Streams.Tests.File as File-import qualified System.IO.Streams.Tests.Handle as Handle-import qualified System.IO.Streams.Tests.Internal as Internal-import qualified System.IO.Streams.Tests.List as List-import qualified System.IO.Streams.Tests.Network as Network-import qualified System.IO.Streams.Tests.Process as Process-import qualified System.IO.Streams.Tests.Text as Text-import qualified System.IO.Streams.Tests.Vector as Vector-import qualified System.IO.Streams.Tests.Zlib as Zlib-import Test.Framework (defaultMain, testGroup)+import qualified System.IO.Streams.Tests.Attoparsec.ByteString as AttoparsecByteString+import qualified System.IO.Streams.Tests.Attoparsec.Text as AttoparsecText+import qualified System.IO.Streams.Tests.Builder as Builder+import qualified System.IO.Streams.Tests.ByteString as ByteString+import qualified System.IO.Streams.Tests.Combinators as Combinators+import qualified System.IO.Streams.Tests.Concurrent as Concurrent+import qualified System.IO.Streams.Tests.Debug as Debug+import qualified System.IO.Streams.Tests.File as File+import qualified System.IO.Streams.Tests.Handle as Handle+import qualified System.IO.Streams.Tests.Internal as Internal+import qualified System.IO.Streams.Tests.List as List+#ifdef ENABLE_NETWORK+import qualified System.IO.Streams.Tests.Network as Network+#endif+import qualified System.IO.Streams.Tests.Process as Process+import qualified System.IO.Streams.Tests.Text as Text+import qualified System.IO.Streams.Tests.Vector as Vector+#ifdef ENABLE_ZLIB+import qualified System.IO.Streams.Tests.Zlib as Zlib+#endif+import Test.Framework (defaultMain, testGroup) ------------------------------------------------------------------------------ main :: IO () main = defaultMain tests where- tests = [ testGroup "Tests.Attoparsec" Attoparsec.tests+ tests = [ testGroup "Tests.Attoparsec.ByteString" AttoparsecByteString.tests+ , testGroup "Tests.Attoparsec.Text" AttoparsecText.tests , testGroup "Tests.Builder" Builder.tests , testGroup "Tests.ByteString" ByteString.tests , testGroup "Tests.Debug" Debug.tests@@ -32,9 +40,13 @@ , testGroup "Tests.Handle" Handle.tests , testGroup "Tests.Internal" Internal.tests , testGroup "Tests.List" List.tests+#ifdef ENABLE_NETWORK , testGroup "Tests.Network" Network.tests+#endif , testGroup "Tests.Process" Process.tests , testGroup "Tests.Text" Text.tests , testGroup "Tests.Vector" Vector.tests+#ifdef ENABLE_ZLIB , testGroup "Tests.Zlib" Zlib.tests+#endif ]