diff --git a/CONTRIBUTORS b/CONTRIBUTORS --- a/CONTRIBUTORS +++ b/CONTRIBUTORS @@ -3,6 +3,7 @@ - Gregory Collins - Gabriel Gonzalez + - Ignat Insarov ------------------------------------------------------------------------------ Contains some code ported from the "blaze-builder-enumerator" package by Simon diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,85 @@ +# 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. diff --git a/io-streams.cabal b/io-streams.cabal --- a/io-streams.cabal +++ b/io-streams.cabal @@ -1,5 +1,5 @@ Name: io-streams -Version: 1.2.1.3 +Version: 1.5.2.2 License: BSD3 License-file: LICENSE Category: Data, Network, IO-Streams @@ -7,8 +7,21 @@ Maintainer: Gregory Collins Cabal-version: >= 1.10 Synopsis: Simple, composable, and easy-to-use stream I/O -Tested-With: GHC==7.8.4, 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,34 +129,42 @@ 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.7, - process >= 1.1 && <1.3, - text >= 0.10 && <1.3, - time >= 1.2 && <1.6, - 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, @@ -154,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, @@ -165,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, @@ -181,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.5, - directory >= 1.1 && <2, - filepath >= 1.2 && <2, - mtl >= 2 && <3, - network >= 2.3 && <2.7, - primitive >= 0.2 && <0.7, - process >= 1 && <1.3, - text >= 0.10 && <1.3, - time >= 1.2 && <1.6, - 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 diff --git a/src/System/IO/Streams.hs b/src/System/IO/Streams.hs --- a/src/System/IO/Streams.hs +++ b/src/System/IO/Streams.hs @@ -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 diff --git a/src/System/IO/Streams/Attoparsec.hs b/src/System/IO/Streams/Attoparsec.hs --- a/src/System/IO/Streams/Attoparsec.hs +++ b/src/System/IO/Streams/Attoparsec.hs @@ -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) diff --git a/src/System/IO/Streams/Attoparsec/ByteString.hs b/src/System/IO/Streams/Attoparsec/ByteString.hs new file mode 100644 --- /dev/null +++ b/src/System/IO/Streams/Attoparsec/ByteString.hs @@ -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 #-} diff --git a/src/System/IO/Streams/Attoparsec/Text.hs b/src/System/IO/Streams/Attoparsec/Text.hs new file mode 100644 --- /dev/null +++ b/src/System/IO/Streams/Attoparsec/Text.hs @@ -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 #-} diff --git a/src/System/IO/Streams/Builder.hs b/src/System/IO/Streams/Builder.hs --- a/src/System/IO/Streams/Builder.hs +++ b/src/System/IO/Streams/Builder.hs @@ -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.2 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,16 +29,16 @@ -- @ -- 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 -- .... -- @ -- @@ -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 diff --git a/src/System/IO/Streams/ByteString.hs b/src/System/IO/Streams/ByteString.hs --- a/src/System/IO/Streams/ByteString.hs +++ b/src/System/IO/Streams/ByteString.hs @@ -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] ------------------------------------------------------------------------------ diff --git a/src/System/IO/Streams/Combinators.hs b/src/System/IO/Streams/Combinators.hs --- a/src/System/IO/Streams/Combinators.hs +++ b/src/System/IO/Streams/Combinators.hs @@ -10,6 +10,8 @@ , outputFoldM , fold , foldM + , fold_ + , foldM_ , any , all , maximum @@ -45,6 +47,7 @@ , zipWith , zipWithM , unzip + , contraunzip -- * Utility , intersperse @@ -69,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: -- -- @ @@ -86,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) @@ -107,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: -- -- @ @@ -122,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) @@ -182,6 +185,61 @@ ------------------------------------------------------------------------------ +-- | A variant of 'System.IO.Streams.fold' suitable for use with composable folds +-- from \'beautiful folding\' libraries like +-- . +-- 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 +-- . +-- 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. -- @@ -691,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 ------------------------------------------------------------------------------ diff --git a/src/System/IO/Streams/Concurrent.hs b/src/System/IO/Streams/Concurrent.hs --- a/src/System/IO/Streams/Concurrent.hs +++ b/src/System/IO/Streams/Concurrent.hs @@ -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 diff --git a/src/System/IO/Streams/Core.hs b/src/System/IO/Streams/Core.hs --- a/src/System/IO/Streams/Core.hs +++ b/src/System/IO/Streams/Core.hs @@ -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 diff --git a/src/System/IO/Streams/Handle.hs b/src/System/IO/Streams/Handle.hs --- a/src/System/IO/Streams/Handle.hs +++ b/src/System/IO/Streams/Handle.hs @@ -10,6 +10,7 @@ ( -- * Handle conversions handleToInputStream , handleToOutputStream + , handleToStreams , inputStreamToHandle , outputStreamToHandle , streamPairToHandle @@ -68,6 +69,29 @@ f (Just x) = if S.null x then hFlush h else S.hPut h x + + +------------------------------------------------------------------------------ +-- | 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) ------------------------------------------------------------------------------ diff --git a/src/System/IO/Streams/Internal.hs b/src/System/IO/Streams/Internal.hs --- a/src/System/IO/Streams/Internal.hs +++ b/src/System/IO/Streams/Internal.hs @@ -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 ------------------------------------------------------------------------------ diff --git a/src/System/IO/Streams/Internal/Attoparsec.hs b/src/System/IO/Streams/Internal/Attoparsec.hs --- a/src/System/IO/Streams/Internal/Attoparsec.hs +++ b/src/System/IO/Streams/Internal/Attoparsec.hs @@ -8,10 +8,10 @@ module System.IO.Streams.Internal.Attoparsec ( -- * Parsing - parseFromStream - , parseFromStreamInternal - , parserToInputStream + parseFromStreamInternal + , ParseData(..) + -- * Parse Exceptions , ParseException(..) @@ -20,14 +20,16 @@ ------------------------------------------------------------------------------ import Control.Exception (Exception, throwIO) -import Control.Monad (when) -import Data.Attoparsec.ByteString.Char8 (Parser, Result, 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 @@ -45,48 +47,43 @@ ------------------------------------------------------------------------------ --- | 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 -{-# 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 @@ -104,49 +101,15 @@ 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 :: Result r -> Either (ByteString, [String], String) r +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") diff --git a/src/System/IO/Streams/List.hs b/src/System/IO/Streams/List.hs --- a/src/System/IO/Streams/List.hs +++ b/src/System/IO/Streams/List.hs @@ -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 :)) ------------------------------------------------------------------------------ diff --git a/src/System/IO/Streams/Text.hs b/src/System/IO/Streams/Text.hs --- a/src/System/IO/Streams/Text.hs +++ b/src/System/IO/Streams/Text.hs @@ -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) diff --git a/src/System/IO/Streams/Vector.hs b/src/System/IO/Streams/Vector.hs --- a/src/System/IO/Streams/Vector.hs +++ b/src/System/IO/Streams/Vector.hs @@ -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 #-} diff --git a/src/System/IO/Streams/Zlib.hs b/src/System/IO/Streams/Zlib.hs --- a/src/System/IO/Streams/Zlib.hs +++ b/src/System/IO/Streams/Zlib.hs @@ -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 ------------------------------------------------------------------------------ diff --git a/test/System/IO/Streams/Tests/Attoparsec.hs b/test/System/IO/Streams/Tests/Attoparsec.hs deleted file mode 100644 --- a/test/System/IO/Streams/Tests/Attoparsec.hs +++ /dev/null @@ -1,112 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module System.IO.Streams.Tests.Attoparsec (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.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 "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 :: 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 diff --git a/test/System/IO/Streams/Tests/Attoparsec/ByteString.hs b/test/System/IO/Streams/Tests/Attoparsec/ByteString.hs new file mode 100644 --- /dev/null +++ b/test/System/IO/Streams/Tests/Attoparsec/ByteString.hs @@ -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 diff --git a/test/System/IO/Streams/Tests/Attoparsec/Text.hs b/test/System/IO/Streams/Tests/Attoparsec/Text.hs new file mode 100644 --- /dev/null +++ b/test/System/IO/Streams/Tests/Attoparsec/Text.hs @@ -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" [] + diff --git a/test/System/IO/Streams/Tests/Builder.hs b/test/System/IO/Streams/Tests/Builder.hs --- a/test/System/IO/Streams/Tests/Builder.hs +++ b/test/System/IO/Streams/Tests/Builder.hs @@ -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 diff --git a/test/System/IO/Streams/Tests/ByteString.hs b/test/System/IO/Streams/Tests/ByteString.hs --- a/test/System/IO/Streams/Tests/ByteString.hs +++ b/test/System/IO/Streams/Tests/ByteString.hs @@ -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) >>= diff --git a/test/System/IO/Streams/Tests/Combinators.hs b/test/System/IO/Streams/Tests/Combinators.hs --- a/test/System/IO/Streams/Tests/Combinators.hs +++ b/test/System/IO/Streams/Tests/Combinators.hs @@ -40,6 +40,8 @@ , testFoldMWorksTwice , testFold , testFoldM + , testFold_ + , testFoldM_ , testUnfoldM , testPredicates , testMap @@ -54,6 +56,7 @@ , testZipWith , testZipWithM , testUnzip + , testContraunzip , testTake , testDrop , testGive @@ -235,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 @@ -343,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' ------------------------------------------------------------------------------ diff --git a/test/System/IO/Streams/Tests/Concurrent.hs b/test/System/IO/Streams/Tests/Concurrent.hs --- a/test/System/IO/Streams/Tests/Concurrent.hs +++ b/test/System/IO/Streams/Tests/Concurrent.hs @@ -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 diff --git a/test/System/IO/Streams/Tests/Handle.hs b/test/System/IO/Streams/Tests/Handle.hs --- a/test/System/IO/Streams/Tests/Handle.hs +++ b/test/System/IO/Streams/Tests/Handle.hs @@ -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 diff --git a/test/System/IO/Streams/Tests/List.hs b/test/System/IO/Streams/Tests/List.hs --- a/test/System/IO/Streams/Tests/List.hs +++ b/test/System/IO/Streams/Tests/List.hs @@ -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" + ] diff --git a/test/System/IO/Streams/Tests/Network.hs b/test/System/IO/Streams/Tests/Network.hs --- a/test/System/IO/Streams/Tests/Network.hs +++ b/test/System/IO/Streams/Tests/Network.hs @@ -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 diff --git a/test/System/IO/Streams/Tests/Process.hs b/test/System/IO/Streams/Tests/Process.hs --- a/test/System/IO/Streams/Tests/Process.hs +++ b/test/System/IO/Streams/Tests/Process.hs @@ -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 diff --git a/test/System/IO/Streams/Tests/Zlib.hs b/test/System/IO/Streams/Tests/Zlib.hs --- a/test/System/IO/Streams/Tests/Zlib.hs +++ b/test/System/IO/Streams/Tests/Zlib.hs @@ -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 diff --git a/test/TestSuite.hs b/test/TestSuite.hs --- a/test/TestSuite.hs +++ b/test/TestSuite.hs @@ -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 ]