io-streams-1.1.2.2/0000755000000000000000000000000012251607076012132 5ustar0000000000000000io-streams-1.1.2.2/README.md0000644000000000000000000000203412251607076013410 0ustar0000000000000000The io-streams library contains simple and easy to use primitives for I/O using streams. Based on simple types with one type parameter (`InputStream a` and `OutputStream a`), io-streams provides a basic interface to side-effecting input and output in `IO` monad with the following features: * three fundamental I/O primitives that anyone can understand: `read :: InputStream a -> IO (Maybe a)`, `unRead :: a -> InputStream a -> IO ()`, and `write :: Maybe a -> OutputStream a -> IO ()`. * simple types and side-effecting IO operations mean straightforward and simple exception handling and resource cleanup using standard Haskell facilities like `bracket`. * code to transform files, handles, and sockets to streams * a variety of combinators for wrapping and transforming streams, including compression and decompression using zlib, controlling precisely how many bytes are read to or written from a socket, buffering output using `blaze-builder`, etc. * support for parsing from streams using `attoparsec`. io-streams-1.1.2.2/LICENSE0000644000000000000000000000274112251607076013143 0ustar0000000000000000Copyright (c) 2012, Google, Inc. Copyright (c) 2012, Erudify AG All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. Neither the names of Google, Erudify, nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. io-streams-1.1.2.2/io-streams.cabal0000644000000000000000000002532512251607076015210 0ustar0000000000000000Name: io-streams Version: 1.1.2.2 License: BSD3 License-file: LICENSE Category: Data, Network, IO-Streams Build-type: Simple Maintainer: Gregory Collins Cabal-version: >= 1.10 Synopsis: Simple, composable, and easy-to-use stream I/O Tested-With: GHC==7.6.2, GHC==7.6.1, GHC==7.4.2, GHC==7.4.1, GHC==7.2.2, GHC==7.0.4 Bug-Reports: https://github.com/snapframework/io-streams/issues Description: /Overview/ . The io-streams library contains simple and easy-to-use primitives for I/O using streams. Most users will want to import the top-level convenience module "System.IO.Streams", which re-exports most of the library: . @ import "System.IO.Streams" (InputStream, OutputStream) import qualified "System.IO.Streams" as Streams @ . For first-time users, @io-streams@ comes with an included tutorial, which can be found in the "System.IO.Streams.Tutorial" module. . /Features/ . The @io-streams@ user API has two basic types: @InputStream a@ and @OutputStream a@, and three fundamental I/O primitives: . @ \-\- read an item from an input stream Streams.'System.IO.Streams.read' :: 'System.IO.Streams.InputStream' a -> IO (Maybe a) . \-\- push an item back to an input stream Streams.'System.IO.Streams.unRead' :: a -> 'System.IO.Streams.InputStream' a -> IO () . \-\- write to an output stream Streams.'System.IO.Streams.write' :: Maybe a -> 'System.IO.Streams.OutputStream' a -> IO () @ . Streams can be transformed by composition and hooked together with provided combinators: . @ ghci> Streams.fromList [1,2,3::Int] >>= Streams.map (*10) >>= Streams.toList [10,20,30] @ . Stream composition leaves the original stream accessible: . @ ghci> input \<- Streams.fromByteString \"long string\" ghci> wrapped \<- Streams.takeBytes 4 input ghci> Streams.read wrapped Just \"long\" ghci> Streams.read wrapped Nothing ghci> Streams.read input Just \" string\" @ . Simple types and operations in the IO monad mean straightforward and simple exception handling and resource cleanup using Haskell standard library facilities like 'Control.Exception.bracket'. . @io-streams@ comes with: . * functions to use files, handles, concurrent channels, sockets, lists, vectors, and more as streams. . * a variety of combinators for wrapping and transforming streams, including compression and decompression using zlib, controlling precisely how many bytes are read from or written to a stream, buffering output using bytestring builders, folds, maps, filters, zips, etc. . * support for parsing from streams using @attoparsec@. . * support for spawning processes and communicating with them using streams. . /ChangeLog/ . [@1.1.2.2@] Allowed newest versions of the @process@, @test-framework@, and @text@ libraries. . [@1.1.2.1@] Fixed build error when compiled against attoparsec-0.10.0.x. . [@1.1.2.0@] Added @System.IO.Streams.Concurrent.makeChanPipe@, to create a simple concurrent pipe between an @InputStream@/@OutputStream@ pair. . [@1.1.1.0@] Added @System.IO.Streams.Network.socketToStreamsWithBufferSize@, allowing control over the size of the receive buffers used when reading from sockets. . [@1.1.0.3@] Fixed an inconsistent version upper bound in the test suite. . [@1.1.0.2@] Fixed a typo in the tutorial. . [@1.1.0.1@] A couple of Haddock markup fixes. . [@1.1.0.0@] Reworked, simplified, and streamlined the internals of the library. Exports from "System.IO.Streams.Internal" relying on Sources and Sinks were deleted because they are no longer necessary: Source(..), Sink(..), defaultPushback, withDefaultPushback, nullSource, nullSink, singletonSource, simpleSource, sourceToStream, sinkToStream, generatorToSource, and consumerToSink. . [@1.0.2.2@] Fixed a bug in which \"takeBytes 0\" was erroneously requesting input from the wrapped stream. . [@1.0.2.1@] Fixed a compile error on GHC 7.0.x. . [@1.0.2.0@] Added "System.IO.Streams.Process" (support for communicating with system processes using streams), added new functions to "System.IO.Streams.Handle" for converting @io-streams@ types to 'System.IO.Handle's. (Now you can pass streams from this library to places that expect Handles and everything will work.) . [@1.0.1.0@] Added 'System.IO.Streams.Combinators.ignoreEof'. . [@1.0.0.1@] Fixed some haddock markup. Extra-Source-Files: CONTRIBUTORS README.md ------------------------------------------------------------------------------ Library hs-source-dirs: src Default-language: Haskell2010 ghc-options: -O2 -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.Builder, System.IO.Streams.ByteString, System.IO.Streams.Combinators, System.IO.Streams.Concurrent, System.IO.Streams.Core, System.IO.Streams.Debug, 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.Search Build-depends: base >= 4 && <5, attoparsec >= 0.10 && <0.11, blaze-builder >= 0.3.1 && <0.4, bytestring >= 0.9 && <0.11, network >= 2.4 && <2.5, primitive >= 0.2 && <0.6, process >= 1 && <1.3, text >= 0.10 && <1.1, time >= 1.2 && <1.5, transformers >= 0.2 && <0.4, vector >= 0.7 && <0.11, zlib-bindings >= 0.1 && <0.2 if impl(ghc >= 7.2) other-extensions: Trustworthy other-extensions: BangPatterns, CPP, DeriveDataTypeable, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, OverloadedStrings, RankNTypes, TypeSynonymInstances ------------------------------------------------------------------------------ Test-suite testsuite Type: exitcode-stdio-1.0 hs-source-dirs: src test Main-is: TestSuite.hs Default-language: Haskell2010 Other-modules: System.IO.Streams.Tests.Attoparsec, System.IO.Streams.Tests.Builder, System.IO.Streams.Tests.ByteString, System.IO.Streams.Tests.Combinators, System.IO.Streams.Tests.Common, System.IO.Streams.Tests.Concurrent, System.IO.Streams.Tests.Debug, System.IO.Streams.Tests.File, 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.Builder, System.IO.Streams.ByteString, System.IO.Streams.Combinators, System.IO.Streams.Concurrent, System.IO.Streams.Core, System.IO.Streams.Debug, 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.Search ghc-options: -O2 -Wall -fhpc -fwarn-tabs -funbox-strict-fields -threaded -fno-warn-unused-do-bind ghc-prof-options: -prof -auto-all if !os(windows) cpp-options: -DENABLE_PROCESS_TESTS Build-depends: base >= 4 && <5, attoparsec >= 0.10 && <0.11, 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.4 && <2.5, primitive >= 0.2 && <0.6, process >= 1 && <1.3, text >= 0.10 && <1.1, time >= 1.2 && <1.5, transformers >= 0.2 && <0.4, vector >= 0.7 && <0.11, zlib-bindings >= 0.1 && <0.2, 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 if impl(ghc >= 7.2) other-extensions: Trustworthy other-extensions: BangPatterns, CPP, DeriveDataTypeable, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, OverloadedStrings, RankNTypes source-repository head type: git location: https://github.com/snapframework/io-streams.git io-streams-1.1.2.2/Setup.hs0000644000000000000000000000005612251607076013567 0ustar0000000000000000import Distribution.Simple main = defaultMain io-streams-1.1.2.2/CONTRIBUTORS0000644000000000000000000000354212251607076014016 0ustar0000000000000000------------------------------------------------------------------------------ IOStreams Contributors: - Gregory Collins - Gabriel Gonzalez ------------------------------------------------------------------------------ Contains some code ported from the "blaze-builder-enumerator" package by Simon Meier and Thomas Sutton, distributed under the following license: Copyright 2010, Thomas Sutton. All rights reserved. Copyright 2011, Simon Meier. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * The names of its contributors may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ''AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. io-streams-1.1.2.2/test/0000755000000000000000000000000012251607076013111 5ustar0000000000000000io-streams-1.1.2.2/test/TestSuite.hs0000644000000000000000000000372312251607076015403 0ustar0000000000000000module 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) ------------------------------------------------------------------------------ main :: IO () main = defaultMain tests where tests = [ testGroup "Tests.Attoparsec" Attoparsec.tests , testGroup "Tests.Builder" Builder.tests , testGroup "Tests.ByteString" ByteString.tests , testGroup "Tests.Debug" Debug.tests , testGroup "Tests.Combinators" Combinators.tests , testGroup "Tests.Concurrent" Concurrent.tests , testGroup "Tests.File" File.tests , testGroup "Tests.Handle" Handle.tests , testGroup "Tests.Internal" Internal.tests , testGroup "Tests.List" List.tests , testGroup "Tests.Network" Network.tests , testGroup "Tests.Process" Process.tests , testGroup "Tests.Text" Text.tests , testGroup "Tests.Vector" Vector.tests , testGroup "Tests.Zlib" Zlib.tests ] io-streams-1.1.2.2/test/System/0000755000000000000000000000000012251607076014375 5ustar0000000000000000io-streams-1.1.2.2/test/System/IO/0000755000000000000000000000000012251607076014704 5ustar0000000000000000io-streams-1.1.2.2/test/System/IO/Streams/0000755000000000000000000000000012251607076016322 5ustar0000000000000000io-streams-1.1.2.2/test/System/IO/Streams/Tests/0000755000000000000000000000000012251607076017424 5ustar0000000000000000io-streams-1.1.2.2/test/System/IO/Streams/Tests/Debug.hs0000644000000000000000000000365612251607076021020 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} module System.IO.Streams.Tests.Debug (tests) where ------------------------------------------------------------------------------ import qualified Data.ByteString.Char8 as S import qualified System.IO.Streams as Streams import qualified System.IO.Streams.Debug as Streams import Test.Framework import Test.Framework.Providers.HUnit import Test.HUnit hiding (Test) ------------------------------------------------------------------------------ tests :: [Test] tests = [ testDebugInput , testDebugOutput ] ------------------------------------------------------------------------------ testDebugInput :: Test testDebugInput = testCase "debug/input" $ do s <- Streams.fromList [S.replicate 100 'a', "foo"] (ds, getDebugOutput) <- Streams.listOutputStream s' <- Streams.debugInputBS "foo" ds s Streams.unRead "blah" s' Streams.skipToEof s' l <- getDebugOutput assertEqual "debugInput" expected l where expected = [ "foo: pushback: \"blah\"\n" , "foo: got chunk: \"blah\"\n" , "foo: got chunk: \"aaaaaaaaaaaaaa ... aaaaaaaaaaaaaa\" (100 bytes)\n" , "foo: got chunk: \"foo\"\n" , "foo: got EOF\n" ] ------------------------------------------------------------------------------ testDebugOutput :: Test testDebugOutput = testCase "debug/output" $ do is <- Streams.fromList [S.replicate 100 'a', "foo"] o <- Streams.makeOutputStream f (ds, getDebugOutput) <- Streams.listOutputStream o' <- Streams.debugOutputBS "foo" ds o Streams.connect is o' l <- getDebugOutput assertEqual "debugInput" expected l where f !_ = return () expected = [ "foo: got chunk: \"aaaaaaaaaaaaaa ... aaaaaaaaaaaaaa\" (100 bytes)\n" , "foo: got chunk: \"foo\"\n" , "foo: got EOF\n" ] io-streams-1.1.2.2/test/System/IO/Streams/Tests/Concurrent.hs0000644000000000000000000000702612251607076022107 0ustar0000000000000000module System.IO.Streams.Tests.Concurrent (tests) where ------------------------------------------------------------------------------ import Control.Concurrent import Control.Monad import Prelude hiding (lines, read, takeWhile, unlines, unwords, unwords, words) import qualified Prelude import qualified System.IO.Streams as Streams import qualified System.IO.Streams.Concurrent as Streams import System.IO.Streams.Tests.Common import Test.Framework import Test.Framework.Providers.HUnit import Test.Framework.Providers.QuickCheck2 import Test.HUnit hiding (Test) import Test.QuickCheck hiding (output) import Test.QuickCheck.Monadic ------------------------------------------------------------------------------ tests :: [Test] tests = [ testMakeChanPipe , testConcurrentMerge , testConcurrentMergeException , testInputOutput ] ------------------------------------------------------------------------------ testMakeChanPipe :: Test testMakeChanPipe = testProperty "concurrent/makeChanPipe" $ monadicIO $ forAllM arbitrary prop where prop :: [Int] -> PropertyM IO () prop l = liftQ $ do (is, os) <- Streams.makeChanPipe _ <- forkIO $ Streams.writeList l os >> Streams.write Nothing os Streams.toList is >>= assertEqual "makeChanPipe" l ------------------------------------------------------------------------------ testConcurrentMerge :: Test testConcurrentMerge = testCase "concurrent/concurrentMerge" $ do mvars <- replicateM nthreads newEmptyMVar chans <- replicateM nthreads newChan let firstMVar = head mvars mapM_ (forkIO . ring) $ zip3 mvars (take nthreads $ drop 1 $ cycle mvars) chans inputs <- mapM Streams.chanToInput chans resultMVar <- newEmptyMVar forkIO (Streams.concurrentMerge inputs >>= Streams.toList >>= putMVar resultMVar) putMVar firstMVar 0 result <- takeMVar resultMVar assertEqual "concurrent merge" [0..10] result where maxval = 10 :: Int nthreads = 4 :: Int ring (prev, next, chan) = loop where loop = do x <- takeMVar prev if x > maxval then do writeChan chan Nothing putMVar next x else do writeChan chan $ Just x threadDelay 100000 putMVar next $! x + 1 loop ------------------------------------------------------------------------------ testConcurrentMergeException :: Test testConcurrentMergeException = testCase "concurrent/concurrentMerge/exception" $ do inp <- Streams.makeInputStream (error "bad") >>= Streams.concurrentMerge . (:[]) expectExceptionH (Streams.toList inp) ------------------------------------------------------------------------------ testInputOutput :: Test testInputOutput = testCase "concurrent/input-output" $ do is <- Streams.fromList [1..10::Int] chan <- newChan is' <- Streams.chanToInput chan Streams.inputToChan is chan Streams.toList is' >>= assertEqual "input-output" [1..10] io-streams-1.1.2.2/test/System/IO/Streams/Tests/Common.hs0000644000000000000000000000701712251607076021215 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module System.IO.Streams.Tests.Common where ------------------------------------------------------------------------------ import Control.DeepSeq import Control.Exception import qualified Control.Exception as E import Control.Monad import Control.Monad.Trans import qualified Data.ByteString as S import Data.ByteString.Internal (c2w) import qualified Data.ByteString.Lazy as L import Data.Typeable import Test.QuickCheck import Test.QuickCheck.Monadic import qualified Test.QuickCheck.Monadic as QC ------------------------------------------------------------------------------ instance Arbitrary S.ByteString where arbitrary = liftM (S.pack . map c2w) arbitrary instance Arbitrary L.ByteString where arbitrary = do n <- choose(0,5) chunks <- replicateM n arbitrary return $ L.fromChunks chunks ------------------------------------------------------------------------------ eatException :: IO a -> IO () eatException a = (a >> return ()) `E.catch` handler where handler :: SomeException -> IO () handler _ = return () ------------------------------------------------------------------------------ forceSameType :: a -> a -> a forceSameType _ a = a ------------------------------------------------------------------------------ -- | Kill the false negative on derived show instances. coverShowInstance :: (MonadIO m, Show a) => a -> m () coverShowInstance x = liftIO (a >> b >> c) where a = eatException $ evaluate $ showsPrec 0 x "" b = eatException $ evaluate $ show x c = eatException $ evaluate $ showList [x] "" ------------------------------------------------------------------------------ coverReadInstance :: (MonadIO m, Read a) => a -> m () coverReadInstance x = do liftIO $ eatException $ evaluate $ forceSameType [(x,"")] $ readsPrec 0 "" liftIO $ eatException $ evaluate $ forceSameType [([x],"")] $ readList "" ------------------------------------------------------------------------------ coverEqInstance :: (Monad m, Eq a) => a -> m () coverEqInstance x = a `seq` b `seq` return () where a = x == x b = x /= x ------------------------------------------------------------------------------ coverOrdInstance :: (Monad m, Ord a) => a -> m () coverOrdInstance x = a `deepseq` b `deepseq` return () where a = [ x < x , x >= x , x > x , x <= x , compare x x == EQ ] b = min a $ max a a ------------------------------------------------------------------------------ coverTypeableInstance :: (Monad m, Typeable a) => a -> m () coverTypeableInstance a = typeOf a `seq` return () ------------------------------------------------------------------------------ expectException :: IO a -> PropertyM IO () expectException m = do e <- liftQ $ try m case e of Left (z::SomeException) -> (length $ show z) `seq` return () Right _ -> fail "expected exception, didn't get one" ------------------------------------------------------------------------------ expectExceptionH :: IO a -> IO () expectExceptionH act = do e <- try act case e of Left (z::SomeException) -> (length $ show z) `seq` return () Right _ -> fail "expected exception, didn't get one" ------------------------------------------------------------------------------ liftQ :: forall a m . (Monad m) => m a -> PropertyM m a liftQ = QC.run io-streams-1.1.2.2/test/System/IO/Streams/Tests/Combinators.hs0000644000000000000000000003460212251607076022245 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} module System.IO.Streams.Tests.Combinators (tests) where ------------------------------------------------------------------------------ import Control.Applicative import Control.Monad hiding (filterM, mapM, mapM_) import qualified Control.Monad as CM import Data.IORef import Data.List hiding (drop, filter, take, unzip, zip, zipWith) import Prelude hiding (drop, filter, mapM, mapM_, read, take, unzip, zip, zipWith) import qualified Prelude import System.IO.Streams hiding (all, any, maximum, minimum) import qualified System.IO.Streams as S import Test.Framework import Test.Framework.Providers.HUnit import Test.Framework.Providers.QuickCheck2 import Test.HUnit hiding (Test) import Test.QuickCheck hiding (output) import Test.QuickCheck.Monadic ------------------------------------------------------------------------------ import System.IO.Streams.Tests.Common ------------------------------------------------------------------------------ tests :: [Test] tests = [ testFilter , testFilterM , testFilterOutput , testFilterOutputM , testFoldMWorksTwice , testFold , testFoldM , testUnfoldM , testPredicates , testMap , testContramap , testMapM , testMapM_ , testContramapM_ , testSkipToEof , testZip , testZipWith , testZipWithM , testUnzip , testTake , testDrop , testGive , testIgnore , testIgnoreEof , testAtEnd ] ------------------------------------------------------------------------------ testFoldMWorksTwice :: Test testFoldMWorksTwice = testCase "combinators/foldMWorksTwice" $ do (os, grab) <- nullOutput >>= outputFoldM f (0::Int) let l = [1,2,3] fromList l >>= supplyTo os m <- grab assertEqual "foldm1" (sum l) m let l2 = [4,5,6] fromList l2 >>= supplyTo os m2 <- grab assertEqual "foldm2" (sum l2) m2 (is, grab2) <- fromList l >>= inputFoldM f (0::Int) _ <- read is x <- grab2 assertEqual "foldm3" 1 x _ <- read is >> read is y <- grab2 assertEqual "foldm4" 5 y read is >>= assertEqual "eof" Nothing where f a b = return (a+b) ------------------------------------------------------------------------------ testMapM :: Test testMapM = testCase "combinators/mapM" $ do is <- fromList [1,2,3::Int] >>= mapM (return . (1+)) l <- toList is assertEqual "mapM" [2,3,4] l ------------------------------------------------------------------------------ testMap :: Test testMap = testCase "combinators/map" $ do is <- fromList [1,2,3::Int] >>= S.map (1+) l <- toList is assertEqual "map" [2,3,4] l ------------------------------------------------------------------------------ testContramap :: Test testContramap = testCase "combinators/contramap" $ do is <- fromList [1,2,3::Int] l <- outputToList (contramap (+1) >=> connect is) assertEqual "contramap" [2,3,4] l ------------------------------------------------------------------------------ testMapM_ :: Test testMapM_ = testCase "combinators/mapM_" $ do ref <- newIORef 0 is <- fromList [1,2,3::Int] >>= mapM_ (modifyIORef ref . (+)) _ <- toList is readIORef ref >>= assertEqual "mapM_" 6 ------------------------------------------------------------------------------ testContramapM_ :: Test testContramapM_ = testCase "combinators/contramapM_" $ do ref <- newIORef 0 is <- fromList [1,2,3::Int] _ <- outputToList (contramapM_ (modifyIORef ref . (+)) >=> connect is) readIORef ref >>= assertEqual "contramapM_" 6 ------------------------------------------------------------------------------ testSkipToEof :: Test testSkipToEof = testCase "combinators/skipToEof" $ do is <- fromList [1,2,3::Int] !_ <- skipToEof is x <- read is assertEqual "skipToEof" Nothing x ------------------------------------------------------------------------------ testFilter :: Test testFilter = testCase "combinators/filter" $ do is <- fromList [1..10::Int] is' <- filter even is read is' >>= assertEqual "read1" (Just 2) unRead 3 is' peek is >>= assertEqual "pushback" (Just 3) toList is' >>= assertEqual "rest" [4,6..10] unRead 20 is' peek is >>= assertEqual "pushback2" (Just 20) toList is' >>= assertEqual "rest2" [20] toList is' >>= assertEqual "eof" [] ------------------------------------------------------------------------------ testFilterM :: Test testFilterM = testCase "combinators/filterM" $ do is <- fromList [1..10::Int] is' <- filterM (return . even) is read is' >>= assertEqual "read1" (Just 2) unRead 3 is' peek is >>= assertEqual "pushback" (Just 3) toList is' >>= assertEqual "rest" [4,6..10] unRead 20 is' peek is >>= assertEqual "pushback2" (Just 20) toList is' >>= assertEqual "rest2" [20] toList is' >>= assertEqual "eof" [] ------------------------------------------------------------------------------ testFilterOutput :: Test testFilterOutput = testCase "combinators/filterOutput" $ do is <- fromList [1..10::Int] l <- outputToList (\os -> filterOutput even os >>= connect is) assertEqual "filterOutput" (Prelude.filter even [1..10]) l ------------------------------------------------------------------------------ testFilterOutputM :: Test testFilterOutputM = testCase "combinators/filterOutputM" $ do is <- fromList [1..10::Int] l <- outputToList (\os -> filterOutputM (return . even) os >>= connect is) assertEqual "filterOutputM" (Prelude.filter even [1..10]) l ------------------------------------------------------------------------------ testFold :: Test testFold = testCase "combinators/fold" $ do fromList [1..10::Int] >>= S.fold (+) 0 >>= assertEqual "fold1" (sum [1..10]) ------------------------------------------------------------------------------ testFoldM :: Test testFoldM = testCase "combinators/foldM" $ do fromList [1..10::Int] >>= S.foldM ((return .) . (+)) 0 >>= assertEqual "fold2" (sum [1..10]) ------------------------------------------------------------------------------ testUnfoldM :: Test testUnfoldM = testCase "combinators/unfoldM" $ do S.unfoldM gen 0 >>= toList >>= assertEqual "unfold" result where gen !n = return $! if n < 10 then Just (n, n + 1) else Nothing result = [0, 1 .. 9 :: Int] ------------------------------------------------------------------------------ data StreamPred = forall c . (Eq c, Show c) => P ([Int] -> c, InputStream Int -> IO c, String) testPredicates :: Test testPredicates = testProperty "combinators/predicates" $ monadicIO $ forAllM arbitrary prop where predicates :: [StreamPred] predicates = [ P (all even , S.all even , "all" ) , P (any even , S.any even , "any" ) , P (nl maximum , S.maximum , "maximum" ) , P (nl minimum , S.minimum , "minimum" ) ] nl f l = if null l then Nothing else Just (f l) prop :: [Int] -> PropertyM IO () prop l = liftQ $ CM.mapM_ (p l) predicates p :: [Int] -> StreamPred -> IO () p l (P (pPred, pStream, name)) = fromList l >>= pStream >>= assertEqual name (pPred l) ------------------------------------------------------------------------------ testZipWithM :: Test testZipWithM = testCase "combinators/zipWithM" $ do let l1 = [1 .. 10 :: Int] let l2 = [2 .. 10 :: Int] (join $ S.zipWithM ((return .) . (+)) <$> fromList l1 <*> fromList l2) >>= toList >>= assertEqual "zipWith1" (Prelude.zipWith (+) l1 l2) (join $ S.zipWithM ((return .) . (+)) <$> fromList l2 <*> fromList l1) >>= toList >>= assertEqual "zipWith1" (Prelude.zipWith (+) l2 l1) is1 <- fromList l1 is2 <- fromList l2 isZip <- S.zipWithM ((return .) . (+)) is1 is2 _ <- toList isZip read is1 >>= assertEqual "remainder" (Just 10) ------------------------------------------------------------------------------ testZipWith :: Test testZipWith = testCase "combinators/zipWith" $ do let l1 = [1 .. 10 :: Int] let l2 = [2 .. 10 :: Int] (join $ S.zipWith (+) <$> fromList l1 <*> fromList l2) >>= toList >>= assertEqual "zipWith1" (Prelude.zipWith (+) l1 l2) (join $ S.zipWith (+) <$> fromList l2 <*> fromList l1) >>= toList >>= assertEqual "zipWith1" (Prelude.zipWith (+) l2 l1) is1 <- fromList l1 is2 <- fromList l2 isZip <- S.zipWith (+) is1 is2 _ <- toList isZip read is1 >>= assertEqual "remainder" (Just 10) ------------------------------------------------------------------------------ testZip :: Test testZip = testCase "combinators/zip" $ do let l1 = [1 .. 10 :: Int] let l2 = [2 .. 10 :: Int] (join $ zip <$> fromList l1 <*> fromList l2) >>= toList >>= assertEqual "zip1" (Prelude.zip l1 l2) (join $ zip <$> fromList l2 <*> fromList l1) >>= toList >>= assertEqual "zip2" (Prelude.zip l2 l1) is1 <- fromList l1 is2 <- fromList l2 isZip <- zip is1 is2 _ <- toList isZip read is1 >>= assertEqual "remainder" (Just 10) ------------------------------------------------------------------------------ testUnzip :: Test testUnzip = testCase "combinators/unzip" $ do let l1 = [1 .. 10 :: Int] l2 = [2 .. 10 :: Int] l = Prelude.zip l1 l2 (is1, is2) <- fromList l >>= unzip toList is1 >>= assertEqual "unzip1-a" (fst $ Prelude.unzip l) toList is2 >>= assertEqual "unzip1-b" (snd $ Prelude.unzip l) read is1 >>= assertEqual "unzip1-read-a" Nothing read is2 >>= assertEqual "unzip1-read-b" Nothing (is3, is4) <- fromList l >>= unzip toList is4 >>= assertEqual "unzip2-b" (snd $ Prelude.unzip l) toList is3 >>= assertEqual "unzip2-a" (fst $ Prelude.unzip l) read is4 >>= assertEqual "unzip2-read-b" Nothing read is3 >>= assertEqual "unzip2-read" Nothing ------------------------------------------------------------------------------ testTake :: Test testTake = testCase "combinators/take" $ do fromList ([]::[Int]) >>= take 0 >>= toList >>= assertEqual "empty 0" [] fromList ([]::[Int]) >>= take 10 >>= toList >>= assertEqual "empty 10" [] forM_ [0..4] $ \n -> fromList [1,2,3::Int] >>= take n >>= toList >>= assertEqual ("for " ++ show n) (Prelude.take (fromEnum n) [1..3]) is <- fromList [1,2,3::Int] is' <- take 2 is void $ read is' unRead 0 is' peek is >>= assertEqual "pb" (Just 0) toList is' >>= assertEqual "toList" [0,2] unRead 7 is' peek is >>= assertEqual "pb2" (Just 7) toList is' >>= assertEqual "toList2" [7] ------------------------------------------------------------------------------ testDrop :: Test testDrop = testCase "combinators/drop" $ do fromList ([]::[Int]) >>= take 0 >>= toList >>= assertEqual "empty 0" [] fromList ([]::[Int]) >>= take 10 >>= toList >>= assertEqual "empty 10" [] forM_ [0..4] $ \n -> fromList [1,2,3::Int] >>= drop n >>= toList >>= assertEqual ("for " ++ show n) (Prelude.drop (fromEnum n) [1..3]) is <- fromList [1,2,3::Int] is' <- drop 1 is read is' >>= assertEqual "read" (Just 2) unRead 0 is' peek is >>= assertEqual "pb" (Just 0) toList is' >>= assertEqual "toList" [0,3] unRead 7 is' peek is >>= assertEqual "pb2" (Just 7) toList is' >>= assertEqual "toList2" [7] toList is' >>= assertEqual "toList2_empty" [] is2 <- fromList [1,2,3::Int] is2' <- drop 1 is2 read is2' >>= assertEqual "read2" (Just 2) unRead 2 is2' unRead 1 is2' unRead 0 is2' toList is2' >>= assertEqual "toList3" [2,3] ------------------------------------------------------------------------------ testGive :: Test testGive = testCase "combinators/give" $ forM_ [0..12] tgive where tgive n = fromList [1..10::Int] >>= \is -> outputToList (\os -> give n os >>= connect is) >>= assertEqual ("give" ++ show n) (Prelude.take (fromEnum n) [1..10]) ------------------------------------------------------------------------------ testIgnore :: Test testIgnore = testCase "combinators/ignore" $ forM_ [0..12] tign where tign n = fromList [1..10::Int] >>= \is -> outputToList (\os -> ignore n os >>= connect is) >>= assertEqual ("ignore" ++ show n) (Prelude.drop (fromEnum n) [1..10]) ------------------------------------------------------------------------------ testIgnoreEof :: Test testIgnoreEof = testCase "combinators/ignoreEof" $ do eofRef <- newIORef 0 chunkRef <- newIORef [] str0 <- S.makeOutputStream $ f eofRef chunkRef str <- S.ignoreEof str0 S.write (Just 0) str S.write Nothing str readIORef eofRef >>= assertEqual "eof ignored" (0::Int) readIORef chunkRef >>= assertEqual "input propagated" [0::Int] where f ref _ Nothing = modifyIORef ref (+1) f _ chunk (Just x) = modifyIORef chunk (++ [x]) ------------------------------------------------------------------------------ testAtEnd :: Test testAtEnd = testCase "combinators/atEndOfInput" $ do boolRef <- newIORef False is <- fromList [1,2,3::Int] >>= atEndOfInput (writeIORef boolRef True) unRead 0 is toList is >>= assertEqual "list" [0,1,2,3] readIORef boolRef >>= assertBool "ran" toList is >>= assertEqual "list 2" [] unRead 0 is toList is >>= assertEqual "list 3" [0] io-streams-1.1.2.2/test/System/IO/Streams/Tests/List.hs0000644000000000000000000000272612251607076020702 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module System.IO.Streams.Tests.List (tests) where ------------------------------------------------------------------------------ import Control.Monad hiding (mapM) import Prelude hiding (mapM, read) import Test.Framework import Test.Framework.Providers.HUnit import Test.HUnit hiding (Test) ------------------------------------------------------------------------------ import System.IO.Streams.List ------------------------------------------------------------------------------ import System.IO.Streams.Tests.Common (expectExceptionH) tests :: [Test] tests = [ testChunkJoin ] testChunkJoin :: Test testChunkJoin = testCase "list/chunkList and join" $ do expectExceptionH (fromList [1..10::Int] >>= chunkList 0 >>= toList) fromList [1..10 :: Int] >>= chunkList 3 >>= toList >>= assertEqual "chunkList" [ [1,2,3] , [4,5,6] , [7,8,9] , [10] ] fromList [1..12 :: Int] >>= chunkList 3 >>= concatLists >>= toList >>= assertEqual "concatlists" [1..12] io-streams-1.1.2.2/test/System/IO/Streams/Tests/Network.hs0000644000000000000000000000433412251607076021415 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module System.IO.Streams.Tests.Network (tests) where ------------------------------------------------------------------------------ import Control.Concurrent (forkIO, newEmptyMVar, putMVar, takeMVar) import qualified Network.Socket as N import System.Timeout (timeout) import Test.Framework import Test.Framework.Providers.HUnit import Test.HUnit hiding (Test) ------------------------------------------------------------------------------ import qualified System.IO.Streams.Internal as Streams import qualified System.IO.Streams.List as Streams import qualified System.IO.Streams.Network as Streams ------------------------------------------------------------------------------ tests :: [Test] tests = [ testSocket ] testSocket :: Test testSocket = testCase "network/socket" $ N.withSocketsDo $ do x <- timeout (10 * 10^(6::Int)) go assertEqual "ok" (Just ()) x where go = do portMVar <- newEmptyMVar resultMVar <- newEmptyMVar forkIO $ client portMVar resultMVar server portMVar l <- takeMVar resultMVar assertEqual "testSocket" l ["ok"] 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" 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.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.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.close csock N.close sock io-streams-1.1.2.2/test/System/IO/Streams/Tests/Text.hs0000644000000000000000000000501312251607076020703 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module System.IO.Streams.Tests.Text (tests) where ------------------------------------------------------------------------------ import Control.Monad ((>=>)) import Data.Text.Encoding.Error import qualified System.IO.Streams.Internal as Streams import qualified System.IO.Streams.List as Streams import System.IO.Streams.Tests.Common import qualified System.IO.Streams.Text as Streams import Test.Framework import Test.Framework.Providers.HUnit import Test.HUnit hiding (Test) ------------------------------------------------------------------------------ tests :: [Test] tests = [ testDecodeOK , testStrictDecodeError , testEncode ] ------------------------------------------------------------------------------ testEncode :: Test testEncode = testCase "text/encodeUtf8" $ do is <- Streams.fromList ["\x3BC", "ok", ""] Streams.outputToList (Streams.encodeUtf8 >=> Streams.connect is) >>= assertEqual "ok encode" ["\xCE\xBC", "ok", ""] ------------------------------------------------------------------------------ testDecodeOK :: Test testDecodeOK = testCase "text/decodeUtf8/wholeChunk" $ do Streams.fromList ["\xCE\xBC", "ok", ""] >>= Streams.decodeUtf8 >>= Streams.toList >>= assertEqual "ok decode" ["\x3BC", "ok", ""] Streams.fromList ["\xCE", "\xBC", "ok", "foo\xCE", "\xBC"] >>= Streams.decodeUtf8 >>= Streams.toList >>= assertEqual "ok decode 2" ["\x3BC", "ok", "foo", "\x3BC"] Streams.fromList ["\xE2\xB6", "\x8E"] >>= Streams.decodeUtf8 >>= Streams.toList >>= assertEqual "ok decode 3" ["\x2D8E"] Streams.fromList ["\xF0\x90\x80\x83"] >>= Streams.decodeUtf8 >>= Streams.toList >>= assertEqual "ok decode 4" ["\x10003"] Streams.fromList [] >>= Streams.decodeUtf8With strictDecode >>= Streams.toList >>= assertEqual "ok strict empty" [] ------------------------------------------------------------------------------ testStrictDecodeError :: Test testStrictDecodeError = testCase "text/decodeUtf8/error" $ do expectExceptionH (Streams.fromList ["\x87"] >>= Streams.decodeUtf8With strictDecode >>= Streams.toList) expectExceptionH (Streams.fromList ["o\x87\x87"] >>= Streams.decodeUtf8With strictDecode >>= Streams.toList) io-streams-1.1.2.2/test/System/IO/Streams/Tests/Process.hs0000644000000000000000000000612512251607076021402 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module System.IO.Streams.Tests.Process (tests) where ------------------------------------------------------------------------------ import Control.Concurrent import Control.Exception import Control.Monad (liftM, void) import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as S import qualified System.IO.Streams as Streams import System.Timeout import Test.Framework import Test.Framework.Providers.HUnit import Test.HUnit hiding (Test) ------------------------------------------------------------------------------ tests :: [Test] #ifndef ENABLE_PROCESS_TESTS tests = [] #else tests = [ testInteractiveCommand , testInteractiveProcess ] ------------------------------------------------------------------------------ testInteractiveCommand :: Test testInteractiveCommand = testCase "process/interactiveCommand" $ do (out, err) <- Streams.runInteractiveCommand "cat" >>= run [expected] assertEqual "interactiveCommand" expected out assertEqual "interactiveCommand" "" err where expected = "testing 1-2-3" ------------------------------------------------------------------------------ testInteractiveProcess :: Test testInteractiveProcess = testCase "process/interactiveProcess" $ do (out, err) <- Streams.runInteractiveProcess "/usr/bin/tr" ["a-z", "A-Z"] Nothing Nothing >>= run [inputdata] assertEqual "interactiveProcess" expected out assertEqual "interactiveProcess" "" err where inputdata = "testing 1-2-3" expected = "TESTING 1-2-3" ------------------------------------------------------------------------------ run :: [ByteString] -> (Streams.OutputStream ByteString, Streams.InputStream S.ByteString, Streams.InputStream S.ByteString, Streams.ProcessHandle) -> IO (S.ByteString, S.ByteString) run input (stdin, stdout, stderr, processHandle) = tout 5000000 $ do me <- myThreadId outM <- newEmptyMVar errM <- newEmptyMVar bracket (mkThreads me outM errM) killThreads $ go outM errM where tout t m = timeout t m >>= maybe (error "timeout") return barfTo me (e :: SomeException) = throwTo me e killMe restore me m = void (try (restore m) >>= either (barfTo me) return) mkThreads me outM errM = mask $ \restore -> do tid1 <- forkIO $ killMe restore me $ snarf stdout outM tid2 <- forkIO $ killMe restore me $ snarf stderr errM return (tid1, tid2) killThreads (t1, t2) = do mapM_ killThread [t1, t2] Streams.waitForProcess processHandle go outM errM _ = do Streams.fromList input >>= Streams.connectTo stdin out <- takeMVar outM err <- takeMVar errM return (out, err) snarf is mv = liftM S.concat (Streams.toList is) >>= putMVar mv -- ENABLE_PROCESS_TESTS #endif io-streams-1.1.2.2/test/System/IO/Streams/Tests/Handle.hs0000644000000000000000000001620112251607076021153 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} module System.IO.Streams.Tests.Handle (tests) where ------------------------------------------------------------------------------ import Control.Exception import Control.Monad hiding (mapM) import qualified Data.ByteString.Char8 as S import Data.List import Foreign.Marshal.Alloc (allocaBytes) import Foreign.Marshal.Utils (copyBytes) import Foreign.Ptr (castPtr) import qualified GHC.IO.Buffer as HB import qualified GHC.IO.BufferedIO as H import qualified GHC.IO.Device as H import Prelude hiding (mapM, read) import System.Directory import System.FilePath import System.IO hiding (stderr, stdin, stdout) import qualified System.IO as IO import System.IO.Streams (OutputStream) import qualified System.IO.Streams as Streams import qualified System.IO.Streams.Internal as Streams import Test.Framework import Test.Framework.Providers.HUnit import Test.HUnit hiding (Test) ------------------------------------------------------------------------------ import System.IO.Streams.Tests.Common tests :: [Test] tests = [ testHandle , testStdHandles , testInputStreamToHandle , testOutputStreamToHandle , testStreamPairToHandle , testHandleInstances , testHandleBadnesses ] ------------------------------------------------------------------------------ testHandle :: Test testHandle = testCase "handle/files" $ do createDirectoryIfMissing False "tmp" tst `finally` eatException (removeFile fn >> removeDirectory "tmp") where fn = "tmp" "data" tst = do withBinaryFile fn WriteMode $ \h -> do let l = "" : (intersperse " " ["the", "quick", "brown", "fox"]) os <- Streams.handleToOutputStream h Streams.fromList l >>= Streams.connectTo os withBinaryFile fn ReadMode $ \h -> do l <- liftM S.concat (Streams.handleToInputStream h >>= Streams.toList) assertEqual "testFiles" "the quick brown fox" l ------------------------------------------------------------------------------ testStdHandles :: Test testStdHandles = testCase "handle/stdHandles" $ do hClose IO.stdin -- Should generate exception: handle is closed. expectExceptionH (Streams.toList Streams.stdin) Streams.write (Just "") Streams.stdout Streams.write (Just "") Streams.stderr return () ------------------------------------------------------------------------------ testInputStreamToHandle :: Test testInputStreamToHandle = testCase "handle/inputStreamToHandle" $ do h <- Streams.fromList ["foo", "bar", "baz"] >>= Streams.inputStreamToHandle S.hGetContents h >>= assertEqual "inputStreamToHandle" "foobarbaz" ------------------------------------------------------------------------------ testOutputStreamToHandle :: Test testOutputStreamToHandle = testCase "handle/outputStreamToHandle" $ do (os, getInput) <- Streams.listOutputStream h <- Streams.outputStreamToHandle os S.hPutStrLn h "foo" liftM S.concat getInput >>= assertEqual "outputStreamToHandle" "foo\n" ------------------------------------------------------------------------------ testStreamPairToHandle :: Test testStreamPairToHandle = testCase "handle/streamPairToHandle" $ do is <- Streams.fromList ["foo", "bar", "baz"] (os, getInput) <- Streams.listOutputStream h <- Streams.streamPairToHandle is os S.hPutStrLn h "foo" S.hGetContents h >>= assertEqual "input stream" "foobarbaz" liftM S.concat getInput >>= assertEqual "output stream" "foo\n" ------------------------------------------------------------------------------ testHandleBadnesses :: Test testHandleBadnesses = testCase "handle/badness" $ do h <- Streams.fromList ["foo", "bar", "baz"] >>= Streams.inputStreamToHandle _ <- S.hGetContents h expectExceptionH $ S.hGetContents h h' <- Streams.fromList ["foo", "bar", "baz"] >>= Streams.inputStreamToHandle expectExceptionH $ S.hPutStrLn h' "foo" (os, _) <- Streams.listOutputStream h'' <- Streams.outputStreamToHandle os expectExceptionH $ S.hGetContents h'' is <- Streams.fromList ["foo"] h''' <- Streams.streamPairToHandle is os _ <- S.hGetContents h''' expectExceptionH $ S.hGetContents h''' ------------------------------------------------------------------------------ testHandleInstances :: Test testHandleInstances = testCase "handle/ghc-instances" $ do 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 $ H.flushWriteBuffer is undefined expectExceptionH $ H.flushWriteBuffer0 is undefined expectExceptionH $ H.read os undefined undefined expectExceptionH $ H.writeNonBlocking os undefined undefined expectExceptionH $ H.fillReadBuffer0 is undefined expectExceptionH $ H.fillReadBuffer0 os undefined expectExceptionH $ H.fillReadBuffer0 sp undefined H.ready is False 0 >>= assertEqual "ready input" True H.ready os False 0 >>= assertEqual "ready output" True H.ready sp False 0 >>= assertEqual "ready pair" True H.devType is >>= assertBool "devtype input" . (== H.Stream) 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 S.useAsCStringLen "foo" $ \(cstr, l) -> do H.write os (castPtr cstr) l liftM S.concat getList >>= assertEqual "H.write 1" "foo" 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 (l', !buf') <- H.flushWriteBuffer0 sp $ buf { HB.bufR = 3 } assertEqual "flushWriteBuffer0" 3 l' assertEqual "bufR" 0 $ HB.bufR buf' liftM S.concat getList >>= assertEqual "write 3" "foo" allocaBytes 3 $ \buf -> do l <- 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 assertEqual "3 byte read #2" 3 l' S.packCStringLen (castPtr buf, l') >>= assertEqual "second read" "bar" expectExceptionH $ H.read os buf 3 io-streams-1.1.2.2/test/System/IO/Streams/Tests/Builder.hs0000644000000000000000000001033212251607076021345 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} 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.List import Data.Monoid import System.IO.Streams hiding (fromByteString, intersperse, map, take) import Test.Framework import Test.Framework.Providers.HUnit import Test.HUnit hiding (Test) ------------------------------------------------------------------------------ tests :: [Test] tests = [ testBuilderStream , testUnsafeBuilderStream , testSmallBuffer , testSmallBufferWithLargeOutput , testNullStream ] ------------------------------------------------------------------------------ testBuilderStream :: Test 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 is <- fromList l (os0, grab) <- listOutputStream os <- builderStream os0 connect is os output <- grab assertEqual "properly buffered" [ "the quick brown fox" , "" , "jumped over the" ] output ------------------------------------------------------------------------------ testUnsafeBuilderStream :: Test 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 is <- fromList l (os0, grab) <- listOutputStream os1 <- contramapM (return . S.copy) os0 os <- unsafeBuilderStream (allocBuffer 1024) os1 connect is os output <- grab assertEqual "properly buffered" [ "the quick brown fox" , "" , "jumped over the" ] output ------------------------------------------------------------------------------ testSmallBuffer :: Test testSmallBuffer = testCase "builder/smallBuffer" $ do (os0, grab) <- listOutputStream os <- builderStreamWith (allNewBuffersStrategy 10) os0 let l1 = intersperse " " ["the", "quick", "brown"] let l2 = [" fooooooooooooooooox"] let l = map fromByteString l1 ++ [flush, flush, flush] ++ map fromByteString l2 is <- fromList l connect is os output <- liftM S.concat grab assertEqual "short buffer" "the quick brown fooooooooooooooooox" output ------------------------------------------------------------------------------ testSmallBufferWithLargeOutput :: Test testSmallBufferWithLargeOutput = testCase "builder/smallBufferWithLargeOutput" $ do (os0, grab) <- listOutputStream os1 <- contramapM (return . S.copy) os0 os <- unsafeBuilderStream (allocBuffer 10) os1 let l = take 3000 $ cycle $ replicate 20 (fromByteString "bloooooooort") ++ [flush] is <- fromList l let s = toByteString $ mconcat l connect is os output <- liftM S.concat grab assertEqual "short buffer 2" s output write (Just $ fromByteString "ok") os write Nothing os fout <- grab -- no output should be sent because of nullSink assertEqual "nullSink" [] fout ------------------------------------------------------------------------------ testNullStream :: Test testNullStream = testCase "builder/nullStream" $ do (os0, grab) <- listOutputStream os <- builderStream os0 is <- fromList [] connect is os l <- grab assertEqual "null stream" [] l io-streams-1.1.2.2/test/System/IO/Streams/Tests/Vector.hs0000644000000000000000000001052412251607076021224 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module System.IO.Streams.Tests.Vector (tests) where ------------------------------------------------------------------------------ import Control.Monad hiding (mapM) import qualified Data.Vector as V import Prelude hiding (mapM, read) import Test.Framework import Test.Framework.Providers.HUnit import Test.HUnit hiding (Test) ------------------------------------------------------------------------------ import qualified System.IO.Streams as S import System.IO.Streams.List import System.IO.Streams.Vector ------------------------------------------------------------------------------ import System.IO.Streams.Tests.Common (expectExceptionH) ------------------------------------------------------------------------------ tests :: [Test] tests = [ testChunk , testWrite , testVectorOutputStream , testFromTo , testOutputToMutableVector , testToMutableVector ] ------------------------------------------------------------------------------ testChunk :: Test testChunk = testCase "vector/chunkVector" $ do let zeroLen :: IO ([V.Vector Int]) zeroLen = fromList [1..10::Int] >>= chunkVector 0 >>= toList expectExceptionH zeroLen fromList [1..10 :: Int] >>= chunkVector 3 >>= toList >>= assertEqual "chunkVector" (map V.fromList [ [1,2,3] , [4,5,6] , [7,8,9] , [10] ]) fromList [1..12 :: Int] >>= chunkVector 3 >>= toList >>= assertEqual "chunkVector2" (map V.fromList [ [1,2,3] , [4,5,6] , [7,8,9] , [10,11,12] ]) ------------------------------------------------------------------------------ testWrite :: Test testWrite = testCase "vector/writeVector" $ outputToVector act >>= assertEqual "testWrite" (V.fromList [1..10::Int]) where act str = do writeVector (V.fromList [1..10]) str S.write Nothing str S.write Nothing str ------------------------------------------------------------------------------ testVectorOutputStream :: Test testVectorOutputStream = testCase "vector/vectorOutputStream" $ test1 >> test2 where test1 = do (os, flush) <- vectorOutputStream fromList [1,2,3::Int] >>= S.connectTo os flush >>= assertEqual "v1" (V.fromList [1,2,3::Int]) S.write (Just 4) os flush >>= assertEqual "v2" V.empty test2 = do (os, flush) <- mutableVectorOutputStream fromList [1,2,3::Int] >>= S.supplyTo os flush >>= V.unsafeFreeze >>= assertEqual "v1" (V.fromList [1,2,3::Int]) S.write (Just 4) os flush >>= V.unsafeFreeze >>= assertEqual "v2" (V.singleton (4::Int)) ------------------------------------------------------------------------------ testFromTo :: Test testFromTo = testCase "vector/fromVector" $ do fromVector V.empty >>= toVector >>= assertEqual "f1" (V.empty :: V.Vector Int) fromVector vtest >>= toVector >>= assertEqual "f2" vtest where vtest = V.fromList [1..100::Int] ------------------------------------------------------------------------------ testOutputToMutableVector :: Test testOutputToMutableVector = testCase "vector/outputToMutableVector" $ do is <- S.fromList [1::Int,2,3] outputToMutableVector (S.connect is) >>= V.unsafeFreeze >>= assertEqual "outputToMutableVector" (V.fromList [1,2,3]) ------------------------------------------------------------------------------ testToMutableVector :: Test testToMutableVector = testCase "vector/toMutableVector" $ do is <- S.fromList [1::Int,2,3] toMutableVector is >>= V.unsafeFreeze >>= assertEqual "toMutableVector" (V.fromList [1,2,3]) io-streams-1.1.2.2/test/System/IO/Streams/Tests/Internal.hs0000644000000000000000000001205512251607076021537 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} module System.IO.Streams.Tests.Internal (tests) where ------------------------------------------------------------------------------ import Control.Applicative import Control.Monad hiding (mapM) import Control.Monad.IO.Class (liftIO) import Data.IORef import Prelude hiding (mapM, read) import Test.Framework import Test.Framework.Providers.HUnit import Test.HUnit hiding (Test) ------------------------------------------------------------------------------ import System.IO.Streams.Internal import System.IO.Streams.List import System.IO.Streams.Tests.Common tests :: [Test] tests = [ testAppendInput , testConst , testCoverLockingStream , testPeek , testNullInput , testGenerator , testGeneratorInstances , testConsumer , testTrivials ] ------------------------------------------------------------------------------ testAppendInput :: Test testAppendInput = testCase "internal/appendInputStream" $ do s1 <- fromList [1::Int, 2, 3] s2 <- fromList [5, 6, 7] is <- appendInputStream s1 s2 l <- toList is assertEqual "appendInputStream" [1,2,3,5,6,7] l ------------------------------------------------------------------------------ testConst :: Test testConst = testCase "internal/const" $ do is <- makeInputStream (return (Just (1::Int))) read is >>= assertEqual "const" (Just 1) unRead 7 is read is >>= assertEqual "unRead" (Just 7) read is >>= assertEqual "const2" (Just 1) ------------------------------------------------------------------------------ testNullInput :: Test testNullInput = testCase "internal/nullInput" $ do is <- nullInput xs <- replicateM 10 $ read (is :: InputStream Int) assertEqual "nullInput" (replicate 10 Nothing) xs ------------------------------------------------------------------------------ testCoverLockingStream :: Test testCoverLockingStream = testCase "internal/coverLockingStreams" $ do is <- fromList [1::Int, 2, 3] >>= lockingInputStream (os0, grab) <- listOutputStream os <- lockingOutputStream os0 connect is os xs <- grab assertEqual "lockingStreams" [1,2,3] xs write Nothing os write Nothing os unRead 7 is y <- read is assertEqual "unRead" (Just 7) y ------------------------------------------------------------------------------ testPeek :: Test testPeek = testCase "internal/peek" $ do is <- fromList [1::Int, 2, 3] b <- atEOF is assertEqual "eof1" False b x0 <- peek is x1 <- peek is unRead 7 is x2 <- peek is assertEqual "peek" (map Just [1, 1, 7]) [x0, x1, x2] l <- toList is assertEqual "toList" [7, 1, 2, 3] l z <- peek is assertEqual "peekEOF" Nothing z b' <- atEOF is assertEqual "eof2" True b' ------------------------------------------------------------------------------ testGenerator :: Test testGenerator = testCase "internal/generator" $ do is <- fromGenerator $ sequence $ Prelude.map ((>>= yield) . (liftIO . return)) [1..5::Int] toList is >>= assertEqual "generator" [1..5] read is >>= assertEqual "read after EOF" Nothing ------------------------------------------------------------------------------ testGeneratorInstances :: Test testGeneratorInstances = testCase "internal/generatorInstances" $ do fromGenerator g1 >>= toList >>= assertEqual "generator" [2,4..10] fromGenerator g2 >>= toList >>= assertEqual "generator" [2,4..10] where g1 = do l <- fmap (map (*2)) $ return [1..5::Int] fmap id $ sequence_ $ Prelude.map yield l g2 = pure id <*> g1 ------------------------------------------------------------------------------ testConsumer :: Test testConsumer = testCase "internal/consumer" $ do is <- fromList [1..10::Int] ref <- newIORef 0 os <- fromConsumer (fmap id (pure id <*> c ref)) connect is os readIORef ref >>= assertEqual "sum" (sum [1..10]) -- should be nullsink after receiving Nothing write (Just 2) os readIORef ref >>= assertEqual "sum" (sum [1..10]) is2 <- fromList [1..10::Int] os2 <- fromConsumer (return ()) connect is2 os2 where c ref = await >>= maybe (return ()) (\x -> do !t <- liftIO $ readIORef ref liftIO $ writeIORef ref $! t + x c ref) ------------------------------------------------------------------------------ testTrivials :: Test testTrivials = testCase "internal/trivials" $ do coverTypeableInstance (undefined :: InputStream Int) coverTypeableInstance (undefined :: OutputStream Int) coverTypeableInstance (undefined :: Generator Int ()) coverTypeableInstance (undefined :: Consumer Int ()) coverTypeableInstance (undefined :: SP Int Int) io-streams-1.1.2.2/test/System/IO/Streams/Tests/Attoparsec.hs0000644000000000000000000000721012251607076022065 0ustar0000000000000000{-# 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 io-streams-1.1.2.2/test/System/IO/Streams/Tests/Zlib.hs0000644000000000000000000001505712251607076020670 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} 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.Char8 (ByteString) import qualified Data.ByteString.Char8 as S import qualified Data.ByteString.Lazy.Char8 as L import Prelude hiding (mapM, read) import Test.Framework import Test.Framework.Providers.HUnit import Test.Framework.Providers.QuickCheck2 import Test.HUnit hiding (Test) import Test.QuickCheck hiding (output) import Test.QuickCheck.Monadic ------------------------------------------------------------------------------ import System.IO.Streams hiding (fromByteString) import System.IO.Streams.Tests.Common tests :: [Test] tests = [ testIdGzip , testIdCompress , testBigString , testBuilderFlushGZip , testBuilderFlushCompress , testTrivials ] ------------------------------------------------------------------------------ testIdGzip :: Test testIdGzip = testProperty "zlib/idGZip" $ monadicIO $ forAllM arbitrary prop where prop :: [ByteString] -> PropertyM IO () prop l = propId "idGZip" GZ.decompress GZ.compress gunzip gzip l ------------------------------------------------------------------------------ testIdCompress :: Test testIdCompress = testProperty "zlib/idCompress" $ monadicIO $ forAllM arbitrary prop where prop :: [ByteString] -> PropertyM IO () prop l = propId "idCompress" Z.decompress Z.compress decompress compress l ------------------------------------------------------------------------------ propId :: String -> (L.ByteString -> L.ByteString) -> (L.ByteString -> L.ByteString) -> (InputStream ByteString -> IO (InputStream ByteString)) -> (CompressionLevel -> OutputStream ByteString -> IO (OutputStream ByteString)) -> [ByteString] -> PropertyM IO () propId name inf def infStr defStr l0 = do pre (not (null l0) && L.length (L.fromChunks l0) > 0) liftQ $ do let l = L.fromChunks $ l0 ++ [ S.concat $ L.toChunks $ L.take 32000 $ L.fromChunks $ cycle l0 ] let inp = def l is <- fromList (L.toChunks inp) >>= infStr (os0, grab) <- listOutputStream os <- defStr defaultCompressionLevel os0 connect is os outp <- liftM L.fromChunks grab assertEqual name l (inf outp) ------------------------------------------------------------------------------ testBigString :: Test testBigString = testCase "zlib/bigString" $ do let l = S.concat $ L.toChunks $ L.take 640000 $ L.fromChunks $ cycle [ "lfkdsjflkdshflkjdhsfkljhdslkfhdslakjfhlkdsjhflkjdsahflkjhsa" , "39287647893264987368947632198746328974698327649873216498713" , "bznmbxz879hJKHYG^&%^&^%*&^%*&^%*&^%&*^%&*65tykjhdgbmdnvkjch" , "VBUYDUHKJC*(HJKDHLCJBUYEOUIHJCHUOY&*^(*)@HJDNM>= connectTo os out <- liftM L.fromChunks grab let o1 = L.fromChunks [l] let o2 = GZ.decompress out when (o1 /= o2) $ do putStrLn "o1 /= o2" putStrLn $ "o1 = " ++ (show $ S.concat $ L.toChunks $ L.take 1000 o1) ++ "..." putStrLn $ "o2 = " ++ (show $ S.concat $ L.toChunks $ L.take 1000 o2) ++ "..." putStrLn $ "len(o1)=" ++ show (L.length o1) putStrLn $ "len(o2)=" ++ show (L.length o2) assertBool "bigString1" $ o1 == o2 is2 <- fromList ([""] ++ L.toChunks out ++ [""]) >>= gunzip (os1, grab') <- listOutputStream connect is2 os1 out' <- liftM L.fromChunks grab' assertBool "bigString2" $ o1 == out' ------------------------------------------------------------------------------ testBuilderFlushGZip :: Test testBuilderFlushGZip = testProperty "zlib/builderFlushGZip" $ monadicIO $ forAllM arbitrary prop where prop :: (ByteString, ByteString) -> PropertyM IO () prop (a,b) = propBuilderFlush "gzip" GZ.decompress gzipBuilder a b ------------------------------------------------------------------------------ testBuilderFlushCompress :: Test testBuilderFlushCompress = testProperty "zlib/builderFlushCompress" $ monadicIO $ forAllM arbitrary prop where prop :: (ByteString, ByteString) -> PropertyM IO () prop (a,b) = propBuilderFlush "zlib" Z.decompress compressBuilder a b ------------------------------------------------------------------------------ propBuilderFlush :: String -> (L.ByteString -> L.ByteString) -> (CompressionLevel -> OutputStream Builder -> IO (OutputStream Builder)) -> ByteString -> ByteString -> PropertyM IO () 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 , flush, flush ] t 4 [ fromByteString a, flush, flush, fromByteString b ] where t expected input = do (os0, grab) <- listOutputStream os <- builderStream os0 >>= comp defaultCompressionLevel fromList input >>= connectTo os xs <- grab when (length xs /= expected) $ putStrLn $ "xs is " ++ show xs assertEqual (name ++ "/len") expected (length xs) let outp = inf $ L.fromChunks xs assertEqual (name ++ "/eq") (L.fromChunks [a,b]) outp ------------------------------------------------------------------------------ testTrivials :: Test testTrivials = testCase "zlib/trivials" $ do let cl = CompressionLevel 4 coverReadInstance cl coverShowInstance cl coverEqInstance cl io-streams-1.1.2.2/test/System/IO/Streams/Tests/File.hs0000644000000000000000000000673412251607076020651 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module System.IO.Streams.Tests.File (tests) where ------------------------------------------------------------------------------ import Control.Exception import Control.Monad hiding (mapM) import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as S import qualified Data.ByteString.Lazy.Char8 as L import Data.List import Prelude hiding (mapM, read) import System.Directory import System.FilePath import System.IO import System.IO.Streams hiding (intersperse, mapM_) import Test.Framework import Test.Framework.Providers.HUnit import Test.HUnit hiding (Test) ------------------------------------------------------------------------------ import System.IO.Streams.Tests.Common tests :: [Test] tests = [ testFiles , testBigFiles ] ------------------------------------------------------------------------------ copyingListOutputStream :: IO (OutputStream ByteString, IO [ByteString]) copyingListOutputStream = do (os, grab) <- listOutputStream os' <- contramap S.copy os >>= lockingOutputStream return (os', grab) ------------------------------------------------------------------------------ testFiles :: Test testFiles = testCase "file/files" $ do createDirectoryIfMissing False "tmp" sequence_ [tst1, tst2, tst3, tst4, tst5] `finally` cleanup where fn x = ("tmp" "data") ++ show (x :: Int) cleanup = eatException $ do mapM_ (eatException . removeFile . fn) [1, 2, 3, 4, 5] removeDirectory "tmp" tst mode n = do withFileAsOutputExt (fn n) mode (BlockBuffering $ Just 2048) $ \os -> do let l = "" : (intersperse " " ["the", "quick", "brown", "fox"]) fromList l >>= connectTo os l <- liftM S.concat $ withFileAsInput (fn n) toList assertEqual "testFiles" "the quick brown fox" l tst1 = tst WriteMode 1 tst2 = tst AppendMode 2 tst3 = tst ReadWriteMode 3 tst4 = expectExceptionH (tst ReadMode 4) tst5 = do withFileAsOutput (fn 5) $ \os -> do let l = "" : (intersperse " " ["the", "quick", "brown", "fox"]) fromList l >>= connectTo os l <- liftM S.concat $ withFileAsInput (fn 5) toList assertEqual "testFiles" "the quick brown fox" l ------------------------------------------------------------------------------ testBigFiles :: Test testBigFiles = testCase "file/bigFiles" $ do createDirectoryIfMissing False "tmp2" tst `finally` eatException (removeFile fn >> removeDirectory "tmp2") where fn = "tmp2" "data" testSz = 20 * 1024 * 1024 tst = do let l = L.take testSz $ L.cycle $ L.fromChunks (intersperse " " ["the", "quick", "brown", "fox"]) withFileAsOutputExt fn WriteMode NoBuffering $ \os -> do fromList [S.concat $ L.toChunks l] >>= connectTo os l1 <- liftM L.fromChunks $ withFileAsInput fn toList assertBool "testFiles2" (l1 == l) l2 <- liftM L.fromChunks $ withFileAsInputStartingAt 5 fn toList assertBool "testFiles3" (l2 == (L.drop 5 l)) (os, grab) <- copyingListOutputStream unsafeWithFileAsInputStartingAt 0 fn (connectTo os) l3 <- liftM L.fromChunks grab assertBool "testFiles4" (l3 == l) io-streams-1.1.2.2/test/System/IO/Streams/Tests/ByteString.hs0000644000000000000000000005003712251607076022057 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module System.IO.Streams.Tests.ByteString (tests) where ------------------------------------------------------------------------------ import Control.Concurrent import Control.Monad 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.Maybe (isJust) import Data.Monoid import Prelude hiding (lines, read, takeWhile, unlines, unwords, unwords, words) import qualified Prelude import System.IO.Streams hiding (filter, intersperse, mapM_) import System.IO.Streams.Tests.Common import System.Timeout import Test.Framework import Test.Framework.Providers.HUnit import Test.Framework.Providers.QuickCheck2 import Test.HUnit hiding (Test) import Test.QuickCheck hiding (output) import Test.QuickCheck.Monadic ------------------------------------------------------------------------------ tests :: [Test] tests = [ testBoyerMoore , testBoyerMoore2 , testCountInput , testCountInput2 , testCountOutput , testThrowIfTooSlow , testReadExactly , testTakeWhile , testTakeBytes , testTakeBytes2 , testTakeBytes3 , testTakeBytes4 , testThrowIfProducesMoreThan , testThrowIfProducesMoreThan2 , testThrowIfProducesMoreThan3 , testThrowIfConsumesMoreThan , testThrowIfConsumesMoreThan2 , testTrivials , testWriteLazyByteString , testGiveBytes , testGiveExactly , testLines , testWords ] ------------------------------------------------------------------------------ testCountInput :: Test testCountInput = testProperty "bytestring/countInput" $ monadicIO $ forAllM arbitrary prop where prop :: [ByteString] -> PropertyM IO () prop l = liftQ $ do is <- fromList l (is', grab) <- countInput is x <- toList is' n <- grab assertEqual "countInput1" (L.length $ L.fromChunks l) n assertEqual "countInput2" (L.length $ L.fromChunks x) n read is' >>= assertEqual "eof" Nothing unRead "ok" is' peek is >>= assertEqual "peek" (Just "ok") read is' >>= assertEqual "read" (Just "ok") ------------------------------------------------------------------------------ testCountInput2 :: Test testCountInput2 = testCase "bytestring/countInput2" $ do is <- fromList txt (is', getCount) <- countInput is (Just x) <- read is' unRead "0, " is' getCount >>= assertEqual "count1" 5 peek is >>= assertEqual "pushback propagates" (Just "0, ") (liftM (L.fromChunks . (x:)) $ toList is') >>= assertEqual "output" expectedOutput getCount >>= assertEqual "count2" (L.length $ L.fromChunks txt) where txt = ["testing ", "1, ", "2, ", "3"] expectedOutput = "testing 0, 1, 2, 3" ------------------------------------------------------------------------------ testCountOutput :: Test testCountOutput = testProperty "bytestring/countOutput" $ monadicIO $ forAllM arbitrary prop where prop :: [ByteString] -> PropertyM IO () prop l = liftQ $ do is <- fromList l (os0, grab) <- listOutputStream (os, grabLen) <- countOutput os0 connect is os xs <- grab n <- grabLen assertEqual "countOutput1" l xs assertEqual "countOutput2" (L.length $ L.fromChunks l) n ------------------------------------------------------------------------------ testTakeBytes :: Test testTakeBytes = testProperty "bytestring/takeBytes" $ monadicIO $ forAllM arbitrary prop where prop :: L.ByteString -> PropertyM IO () prop l = pre (L.length l > 5) >> liftQ (do let (a,b) = L.splitAt 4 l is <- fromList (L.toChunks l) is' <- takeBytes 4 is x <- liftM L.fromChunks $ toList is' y <- liftM L.fromChunks $ toList is assertEqual "take1" a x assertEqual "take2" b y ) ------------------------------------------------------------------------------ testTakeBytes2 :: Test testTakeBytes2 = testProperty "bytestring/takeBytes2" $ monadicIO $ forAllM arbitrary prop where prop :: L.ByteString -> PropertyM IO () prop l = liftQ $ do is <- fromList (L.toChunks l) is2 <- takeBytes 0 is x <- toList is2 y <- liftM L.fromChunks $ toList is assertEqual "takeBytes3" [] x assertEqual "takeBytes4" l y -- Test that pushback makes it back to the source inputstream is3 <- takeBytes 20 is void $ toList is3 unRead "ok2" is3 unRead "ok1" is3 z <- toList is assertEqual "takeBytes5" ["ok1", "ok2"] z ------------------------------------------------------------------------------ testTakeBytes3 :: Test testTakeBytes3 = testCase "bytestring/takeBytes3" $ do is <- fromLazyByteString (L.fromChunks ["The", "quick", "brown", "fox"]) >>= takeBytes 100 _ <- toList is m <- read is assertEqual "takeBytes3" Nothing m ------------------------------------------------------------------------------ testTakeBytes4 :: Test testTakeBytes4 = testCase "bytestring/takeBytes4" $ do is <- makeInputStream (threadDelay 20000000 >> return Nothing) >>= takeBytes 0 mb <- timeout 100000 $ toList is assertBool "takeBytes4" $ isJust mb ------------------------------------------------------------------------------ testThrowIfProducesMoreThan :: Test testThrowIfProducesMoreThan = testProperty "bytestring/throwIfProducesMoreThan" $ monadicIO $ forAllM arbitrary prop where prop :: L.ByteString -> PropertyM IO () prop l = do pre (L.length l > 5) liftQ $ do is <- fromList $ L.toChunks l is' <- throwIfProducesMoreThan 4 is expectExceptionH $ toList is' ------------------------------------------------------------------------------ testThrowIfProducesMoreThan2 :: Test testThrowIfProducesMoreThan2 = testProperty "bytestring/throwIfProducesMoreThan2" $ monadicIO $ forAllM arbitrary prop where prop :: L.ByteString -> PropertyM IO () prop l = do let n = L.length l liftQ $ do is <- fromList $ L.toChunks l is' <- throwIfProducesMoreThan (n + 1) is l' <- liftM L.fromChunks $ toList is' assertEqual "throwIfProducesMoreThan2" l l' m <- read is' assertEqual "throwIfProducesMoreThan2-2" Nothing m unRead "ok2" is' unRead "ok1" is' z <- toList is assertEqual "throwIfProducesMoreThan2-3" ["ok1", "ok2"] z ------------------------------------------------------------------------------ testThrowIfProducesMoreThan3 :: Test testThrowIfProducesMoreThan3 = testCase "bytestring/throwIfProducesMoreThan3" $ do is <- fromList ["lo", "ngstring"] >>= throwIfProducesMoreThan 4 s <- readExactly 4 is assertEqual "throwIfProducesMoreThan split" "long" s l <- fromList ["ok", "", "", "", ""] >>= throwIfProducesMoreThan 2 >>= toList assertEqual "throwIfProducesMoreThan3" ["ok", "", "", "", ""] l ------------------------------------------------------------------------------ testThrowIfConsumesMoreThan :: Test testThrowIfConsumesMoreThan = testProperty "bytestring/throwIfConsumesMoreThan" $ monadicIO $ forAllM arbitrary prop where prop :: L.ByteString -> PropertyM IO () prop l = do let n = L.length l pre (n > 0) liftQ $ do is <- fromList (L.toChunks l) (os, _) <- listOutputStream os' <- throwIfConsumesMoreThan (n-1) os expectExceptionH $ connect is os' ------------------------------------------------------------------------------ testThrowIfConsumesMoreThan2 :: Test testThrowIfConsumesMoreThan2 = testProperty "bytestring/throwIfConsumesMoreThan2" $ monadicIO $ forAllM arbitrary prop where prop :: L.ByteString -> PropertyM IO () prop l = do let n = L.length l liftQ $ do is <- fromList (L.toChunks l) (os, grab) <- listOutputStream os' <- throwIfConsumesMoreThan n os connect is os' l' <- liftM L.fromChunks grab assertEqual "throwIfConsumesMoreThan" l l' ------------------------------------------------------------------------------ testGiveExactly :: Test testGiveExactly = testCase "bytestring/giveExactly" $ do f 2 >>= assertEqual "ok" ["ok"] expectExceptionH $ f 1 expectExceptionH $ f 3 where f n = do is <- fromByteString "ok" outputToList (giveExactly n >=> connect is) ------------------------------------------------------------------------------ testGiveBytes :: Test testGiveBytes = testProperty "bytestring/giveBytes" $ monadicIO $ forAllM arbitrary prop where prop :: L.ByteString -> PropertyM IO () prop l = do pre (L.length l > 5) let a = L.take 4 l liftQ $ do is <- fromList (L.toChunks l) (os, grab) <- listOutputStream os' <- giveBytes 4 os connect is os' write Nothing os' x <- liftM L.fromChunks grab assertEqual "giveBytes1" a x liftQ $ do is <- fromList $ L.toChunks a (os, grab) <- listOutputStream os' <- giveBytes 10 os connect is os' write Nothing os' x <- liftM L.fromChunks grab assertEqual "giveBytes2" a x ------------------------------------------------------------------------------ testThrowIfTooSlow :: Test testThrowIfTooSlow = testCase "bytestring/throwIfTooSlow" $ do is <- mkList expectExceptionH $ trickleFrom is is' <- mkList void $ toList is' x <- read is' assertEqual "throwIfTooSlow" Nothing x src <- mkSrc src' <- throwIfTooSlow (return ()) 10 2 src void $ toList src' unRead "ok2" src' unRead "ok1" src' l <- toList src assertEqual "throwIfTooSlow/pushback" ["ok1", "ok2"] l where mkSrc = fromList $ Prelude.take 100 $ cycle $ intersperse " " ["the", "quick", "brown", "fox"] mkList = mkSrc >>= throwIfTooSlow (return ()) 10 2 trickleFrom is = go where go = read is >>= maybe (return ()) (\x -> x `seq` (threadDelay 2000000 >> go)) ------------------------------------------------------------------------------ testBoyerMoore :: Test testBoyerMoore = testProperty "bytestring/boyerMoore" $ monadicIO $ forAllM gen prop where genBS range = liftM S.pack $ listOf $ choose range gen :: Gen (ByteString, [ByteString]) gen = do needle <- genBS ('a', 'z') n <- choose (0, 10) hay <- replicateM n $ genBS ('A', 'Z') return (needle, hay) prop :: (ByteString, [ByteString]) -> PropertyM IO () prop (needle, haystack') = do let lneedle = L.fromChunks [needle] let lhaystack = L.fromChunks haystack' pre ((not $ S.null needle) && (not $ L.null lhaystack) && (not $ S.isInfixOf needle $ S.concat haystack')) (lhay, toklist0) <- insertNeedle lneedle lhaystack let stream = L.toChunks $ L.concat [lneedle, lhay] let toklist = (Match needle) : toklist0 -- there should be exactly three matches out <- liftQ (fromList stream >>= search needle >>= toList) let nMatches = length $ filter isMatch out let out' = concatAdj Nothing id out when (nMatches /= 3 || out' /= toklist) $ liftQ $ do putStrLn "got wrong output!!" putStrLn "needle:\n" putStrLn $ show lneedle putStrLn "\nhaystack:\n" mapM_ (putStrLn . show) stream putStrLn "\noutput stream:" mapM_ (putStrLn . show) out putStrLn "\noutput stream (minified):" mapM_ (putStrLn . show) out' putStrLn "\nexpected output:" mapM_ (putStrLn . show) toklist putStrLn "" liftQ $ do assertEqual "boyer-moore matches" 3 nMatches assertEqual "boyer-moore output" toklist out' isMatch (Match _) = True isMatch _ = False concatAdj :: Maybe MatchInfo -> ([MatchInfo] -> [MatchInfo]) -> [MatchInfo] -> [MatchInfo] concatAdj prefix dl [] = dl $ maybe [] (:[]) prefix concatAdj prefix dl (x:xs) = maybe (concatAdj (Just x) dl xs) (\p -> maybe (concatAdj (Just x) (dl . (p:)) xs) (\x' -> concatAdj (Just x') dl xs) (merge p x)) prefix where merge (NoMatch z) y | S.null z = Just y | otherwise = case y of NoMatch x' -> Just $ NoMatch $ z `mappend` x' _ -> Nothing merge (Match _) _ = Nothing insertNeedle lneedle lhaystack = do idxL <- pick $ choose (0, lenL-1) idxN <- pick $ choose (0, lenN-1) idxN2 <- pick $ choose (0, lenN-1) let (l1, l2) = L.splitAt (toEnum idxL) lhaystack let (n1, n2) = L.splitAt (toEnum idxN) lneedle let (n3, n4) = L.splitAt (toEnum idxN2) lneedle let out1 = L.concat [ l1, n1, n2, l2, n3, n4 ] let res = concatAdj Nothing id [ NoMatch $ strict l1 , Match $ strict lneedle , NoMatch $ strict l2 , Match $ strict lneedle ] return (out1, res) where strict = S.concat . L.toChunks lenN = fromEnum $ L.length lneedle lenL = fromEnum $ L.length lhaystack ------------------------------------------------------------------------------ testBoyerMoore2 :: Test testBoyerMoore2 = testCase "bytestring/boyerMoore2" $ do fromList ["bork", "no", "bork", "bor"] >>= search "bork" >>= toList >>= assertEqual "bork!" [ Match "bork", NoMatch "no", Match "bork" , NoMatch "bor" ] fromList [] >>= search "bork" >>= toList >>= assertEqual "nothing" [] fromList ["borkbo", "r"] >>= search "bork" >>= toList >>= assertEqual "borkbo" [Match "bork", NoMatch "bor"] fromList ["borkborkborkb", "o", "r", "k", "b", "o"] >>= search "borkborkbork" >>= toList >>= assertEqual "boooooork" [Match "borkborkbork", NoMatch "borkbo"] fromList ["bbbbb", "o", "r", "k", "bork"] >>= search "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" >>= toList >>= assertEqual "bbbbbbbbb" [NoMatch "bbbbborkbork"] fromList ["bbbbbbbbb", "o", "r", "k"] >>= search "bbbbbbbb" >>= toList >>= assertEqual "bbb2" [Match "bbbbbbbb", NoMatch "bork"] fromList ["bababa", "bo", "rk", "bz", "z", "z", "z"] >>= search "babababork" >>= toList >>= assertEqual "zzz" [Match "babababork", NoMatch "bzzzz"] fromList ["bab", "a", "b"] >>= search "bababa" >>= toList >>= assertEqual "bab" [NoMatch "babab"] fromList ["xxx", "xxxzx", "xx"] >>= search "xxxx" >>= toList >>= assertEqual "xxxx" [Match "xxxx", NoMatch "xxzxxx"] ------------------------------------------------------------------------------ testWriteLazyByteString :: Test testWriteLazyByteString = testProperty "bytestring/writeLazy" $ monadicIO $ forAllM arbitrary prop where prop :: [ByteString] -> PropertyM IO () prop l0 = liftQ $ do let l = filter (not . S.null) l0 let s = L.fromChunks l (os, grab) <- listOutputStream writeLazyByteString s os l' <- grab assertEqual "writeLazy" l l' ------------------------------------------------------------------------------ testReadExactly :: Test testReadExactly = testProperty "bytestring/readExactly" $ monadicIO $ forAllM arbitrary prop where prop l0 = liftQ $ do let l = filter (not . S.null) l0 is <- fromList l let s = L.fromChunks l let n = fromEnum $ L.length s t <- readExactly n is assertEqual "eq" s $ L.fromChunks [t] unRead t is expectExceptionH $ readExactly (n+1) is when (n > 0) $ do is' <- fromList l u <- readExactly (n-1) is' assertEqual "eq2" (L.take (toEnum $ n-1) s) (L.fromChunks [u]) v <- readExactly 1 is' assertEqual "eq3" (L.drop (toEnum $ n-1) s) (L.fromChunks [v]) ------------------------------------------------------------------------------ testTakeWhile :: Test testTakeWhile = testCase "bytestring/takeBytesWhile" $ do is <- fromList ["test", "ing\n", "1-2-3\n1-2-3"] takeBytesWhile (/= '\n') is >>= assertEqual "takeBytesWhile1" (Just "testing") takeBytesWhile (/= '\n') is >>= assertEqual "takeBytesWhile2" (Just "") readExactly 1 is >>= assertEqual "readExactly" "\n" takeBytesWhile (/= '\n') is >>= assertEqual "takeBytesWhile3" (Just "1-2-3") readExactly 1 is >>= assertEqual "readExactly" "\n" takeBytesWhile (/= '\n') is >>= assertEqual "takeBytesWhile4" (Just "1-2-3") takeBytesWhile (/= '\n') is >>= assertEqual "takeBytesWhile4" Nothing ------------------------------------------------------------------------------ testLines :: Test testLines = testCase "bytestring/testLines" $ do fromList ["th", "e\nquick\nbrown", "\n", "", "fox"] >>= lines >>= toList >>= assertEqual "lines" ["the", "quick", "brown", "fox"] fromList [] >>= lines >>= toList >>= assertEqual "empty lines" [] fromList ["ok", "cool"] >>= \is -> outputToList (\os -> unlines os >>= connect is) >>= assertEqual "unlines" ["ok", "\n", "cool", "\n"] ------------------------------------------------------------------------------ testWords :: Test testWords = testCase "bytestring/testWords" $ do fromList ["the quick brown \n\tfox"] >>= words >>= toList >>= assertEqual "words" ["the", "quick", "brown", "fox"] fromList ["ok", "cool"] >>= \is -> outputToList (\os -> unwords os >>= connect is) >>= assertEqual "unlines" ["ok", " ", "cool"] ------------------------------------------------------------------------------ testTrivials :: Test testTrivials = testCase "bytestring/testTrivials" $ do coverTypeableInstance (undefined :: TooManyBytesReadException) coverShowInstance (undefined :: TooManyBytesReadException) coverTypeableInstance (undefined :: TooFewBytesWrittenException) coverShowInstance (undefined :: TooFewBytesWrittenException) coverTypeableInstance (undefined :: TooManyBytesWrittenException) coverShowInstance (undefined :: TooManyBytesWrittenException) coverTypeableInstance (undefined :: RateTooSlowException) coverShowInstance (undefined :: RateTooSlowException) coverTypeableInstance (undefined :: ReadTooShortException) coverEqInstance $ Match "" coverShowInstance $ Match "" coverShowInstance $ NoMatch "" io-streams-1.1.2.2/src/0000755000000000000000000000000012251607076012721 5ustar0000000000000000io-streams-1.1.2.2/src/System/0000755000000000000000000000000012251607076014205 5ustar0000000000000000io-streams-1.1.2.2/src/System/IO/0000755000000000000000000000000012251607076014514 5ustar0000000000000000io-streams-1.1.2.2/src/System/IO/Streams.hs0000644000000000000000000001037312251607076016472 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} -- | This module is a top-level convenience module which re-exports most of the -- @io-streams@ library. -- -- It is recommended to import this module qualified, as follows: -- -- @ -- import "System.IO.Streams" ('Generator', 'InputStream', 'OutputStream') -- import qualified "System.IO.Streams" as Streams -- @ -- -- For an in-depth tutorial on how to use @io-streams@, please see the -- "System.IO.Streams.Tutorial" module. -- -- Is there a function missing from this library? Interested in contributing? -- Send a pull request to . module System.IO.Streams ( -- * Stream types InputStream , OutputStream -- ** A note about resource acquisition\/release semantics -- $resource -- * Creating streams , makeInputStream , makeOutputStream -- * Primitive stream operations , read , unRead , peek , write , atEOF -- * Connecting streams together , connect , connectTo , supply , supplyTo , appendInputStream , concatInputStreams -- * Thread safety \/ concurrency , lockingInputStream , lockingOutputStream -- * Utility streams , nullInput , nullOutput -- * Generator monad -- $generator , Generator , fromGenerator , yield -- * Batteries included , module System.IO.Streams.Builder , module System.IO.Streams.ByteString , module System.IO.Streams.Combinators , module System.IO.Streams.Handle , module System.IO.Streams.File , module System.IO.Streams.List , module System.IO.Streams.Network , module System.IO.Streams.Process , module System.IO.Streams.Text , module System.IO.Streams.Vector , module System.IO.Streams.Zlib ) where ------------------------------------------------------------------------------ import Prelude () ------------------------------------------------------------------------------ import System.IO.Streams.Internal import System.IO.Streams.Builder import System.IO.Streams.ByteString import System.IO.Streams.Combinators import System.IO.Streams.File import System.IO.Streams.Handle import System.IO.Streams.List import System.IO.Streams.Network import System.IO.Streams.Process import System.IO.Streams.Text import System.IO.Streams.Vector import System.IO.Streams.Zlib ------------------------------------------------------------------------------ -- $generator -- #generator# -- -- The 'Generator' monad makes it easier for you to define more complicated -- 'InputStream's. Generators have a couple of basic features: -- -- 'Generator' is a 'MonadIO', so you can run IO actions from within it using -- 'liftIO': -- -- @ -- foo :: 'Generator' r a -- foo = 'liftIO' fireTheMissiles -- @ -- -- 'Generator' has a 'yield' function: -- -- @ -- 'yield' :: r -> 'Generator' r () -- @ -- -- A call to \"'yield' @x@\" causes \"'Just' @x@\" to appear when reading the -- 'InputStream'. Finally, 'Generator' comes with a function to turn a -- 'Generator' into an 'InputStream': -- -- @ -- 'fromGenerator' :: 'Generator' r a -> 'IO' ('InputStream' r) -- @ -- -- Once the 'Generator' action finishes, 'fromGenerator' will cause an -- end-of-stream 'Nothing' marker to appear at the output. Example: -- -- @ -- ghci> (Streams.'fromGenerator' $ 'Control.Monad.sequence' $ 'Prelude.map' Streams.'yield' [1..5::Int]) >>= Streams.'toList' -- [1,2,3,4,5] -- @ ------------------------------------------------------------------------------ -- $resource -- #resource# -- -- In general, the convention within this library is that input and output -- streams do not deal with resource acquisition\/release semantics, with rare -- exceptions like 'System.IO.Streams.withFileAsInput'. For example, sending -- \"end-of-stream\" to an 'OutputStream' wrapped around a 'System.IO.Handle' -- doesn't cause the handle to be closed. You can think of streams as little -- state machines that are attached to the underlying resources, and the -- finalization\/release of these resources is up to you. -- -- This means that you can use standard Haskell idioms like -- 'Control.Exception.bracket' to handle resource acquisition and cleanup in an -- exception-safe way. -- io-streams-1.1.2.2/src/System/IO/Streams/0000755000000000000000000000000012251607076016132 5ustar0000000000000000io-streams-1.1.2.2/src/System/IO/Streams/Debug.hs0000644000000000000000000000745312251607076017525 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- | Convenience module for debugging streams. Provides stream transformers -- that wrap 'InputStream's and 'OutputStream's, sending a description of all -- data to an 'OutputStream' for debugging. module System.IO.Streams.Debug ( -- * Debuggers debugInput , debugOutput , debugInputBS , debugOutputBS ) where import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as S import System.IO.Streams.Internal (InputStream (..), OutputStream) import qualified System.IO.Streams.Internal as Streams ------------------------------------------------------------------------------ debugInput :: (a -> ByteString) -- ^ function to convert stream elements to -- 'ByteString' -> ByteString -- ^ name of this debug stream, will be -- prepended to debug output -> OutputStream ByteString -- ^ stream the debug info will be sent to -> InputStream a -- ^ input stream -> IO (InputStream a) debugInput toBS name debugStream inputStream = return $ InputStream produce pb where produce = do m <- Streams.read inputStream Streams.write (Just $! describe m) debugStream return m pb c = do let s = S.concat [name, ": pushback: ", toBS c, "\n"] Streams.write (Just s) debugStream Streams.unRead c inputStream describe m = S.concat [name, ": got ", describeChunk m, "\n"] describeChunk Nothing = "EOF" describeChunk (Just s) = S.concat [ "chunk: ", toBS s ] ------------------------------------------------------------------------------ debugInputBS :: ByteString -- ^ name of this debug stream, will be -- prepended to debug output -> OutputStream ByteString -- ^ stream the debug info will be sent to -> InputStream ByteString -- ^ input stream -> IO (InputStream ByteString) debugInputBS = debugInput condense ------------------------------------------------------------------------------ debugOutput :: (a -> ByteString) -- ^ function to convert stream -- elements to 'ByteString' -> ByteString -- ^ name of this debug stream, will be -- prepended to debug output -> OutputStream ByteString -- ^ debug stream -> OutputStream a -- ^ output stream -> IO (OutputStream a) debugOutput toBS name debugStream outputStream = Streams.makeOutputStream f where f m = do Streams.write (Just $ describe m) debugStream Streams.write m outputStream describe m = S.concat [name, ": got ", describeChunk m, "\n"] describeChunk Nothing = "EOF" describeChunk (Just s) = S.concat [ "chunk: ", toBS s] ------------------------------------------------------------------------------ debugOutputBS :: ByteString -- ^ name of this debug stream, will be -- prepended to debug output -> OutputStream ByteString -- ^ stream the debug info will be sent to -> OutputStream ByteString -- ^ output stream -> IO (OutputStream ByteString) debugOutputBS = debugOutput condense ------------------------------------------------------------------------------ condense :: ByteString -> ByteString condense s | l < 32 = S.concat [ "\"", s, "\"" ] | otherwise = S.concat [ "\"" , S.take k s , " ... " , S.drop (l - k) s , "\" (" , S.pack (show l) , " bytes)" ] where k = 14 l = S.length s io-streams-1.1.2.2/src/System/IO/Streams/Concurrent.hs0000644000000000000000000001000712251607076020606 0ustar0000000000000000-- | Stream utilities for working with concurrent channels. {-# LANGUAGE BangPatterns #-} module System.IO.Streams.Concurrent ( -- * Channel conversions inputToChan , chanToInput , chanToOutput , concurrentMerge , makeChanPipe ) where ------------------------------------------------------------------------------ import Control.Applicative ((<$>), (<*>)) import Control.Concurrent (forkIO) import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan) import Control.Concurrent.MVar (modifyMVar, newEmptyMVar, newMVar, putMVar, takeMVar) import Control.Exception (SomeException, mask, throwIO, try) import Control.Monad (forM_) import Prelude hiding (read) ------------------------------------------------------------------------------ import System.IO.Streams.Internal (InputStream, OutputStream, makeInputStream, makeOutputStream, read) ------------------------------------------------------------------------------ -- | Writes the contents of an input stream to a channel until the input stream -- yields end-of-stream. inputToChan :: InputStream a -> Chan (Maybe a) -> IO () inputToChan is ch = go where go = do mb <- read is writeChan ch mb maybe (return $! ()) (const go) mb ------------------------------------------------------------------------------ -- | Turns a 'Chan' into an input stream. -- chanToInput :: Chan (Maybe a) -> IO (InputStream a) chanToInput ch = makeInputStream $! readChan ch ------------------------------------------------------------------------------ -- | Turns a 'Chan' into an output stream. -- chanToOutput :: Chan (Maybe a) -> IO (OutputStream a) chanToOutput = makeOutputStream . writeChan ------------------------------------------------------------------------------ -- | Concurrently merges a list of 'InputStream's, combining values in the -- order they become available. -- -- Note: does /not/ forward individual end-of-stream notifications, the -- 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. concurrentMerge :: [InputStream a] -> IO (InputStream a) concurrentMerge iss = do mv <- newEmptyMVar nleft <- newMVar $! length iss mask $ \restore -> forM_ iss $ \is -> forkIO $ do let producer = do emb <- try $ restore $ read is case emb of Left exc -> do putMVar mv (Left (exc :: SomeException)) producer Right Nothing -> putMVar mv $! Right Nothing Right x -> putMVar mv (Right x) >> producer producer makeInputStream $ chunk mv nleft where chunk mv nleft = do emb <- takeMVar mv case emb of Left exc -> throwIO exc Right Nothing -> do x <- modifyMVar nleft $ \n -> let !n' = n - 1 in return $! (n', n') if x > 0 then chunk mv nleft else return Nothing Right x -> return x -------------------------------------------------------------------------------- -- | Create a new pair of streams using an underlying 'Chan'. Everything written -- to the 'OutputStream' will appear as-is on the 'InputStream'. -- -- Since reading from the 'InputStream' and writing to the 'OutputStream' are -- blocking calls, be sure to do so in different threads. makeChanPipe :: IO (InputStream a, OutputStream a) makeChanPipe = do chan <- newChan (,) <$> chanToInput chan <*> chanToOutput chan io-streams-1.1.2.2/src/System/IO/Streams/Combinators.hs0000644000000000000000000006122012251607076020747 0ustar0000000000000000-- | Generic stream manipulations {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveDataTypeable #-} module System.IO.Streams.Combinators ( -- * Folds inputFoldM , outputFoldM , fold , foldM , any , all , maximum , minimum -- * Unfolds , unfoldM -- * Maps , map , mapM , mapM_ , contramap , contramapM , contramapM_ -- * Filter , filter , filterM , filterOutput , filterOutputM -- * Takes and drops , give , take , drop , ignore -- * Zip and unzip , zip , zipWith , zipWithM , unzip -- * Utility , intersperse , skipToEof , ignoreEof , atEndOfInput , atEndOfOutput ) where ------------------------------------------------------------------------------ import Control.Concurrent.MVar (newMVar, withMVar) import Control.Monad (liftM, void, when) import Control.Monad.IO.Class (liftIO) import Data.Int (Int64) import Data.IORef (atomicModifyIORef, modifyIORef, newIORef, readIORef, writeIORef) import Data.Maybe (isJust) import Prelude hiding (all, any, drop, filter, map, mapM, mapM_, maximum, minimum, read, take, unzip, zip, zipWith) ------------------------------------------------------------------------------ import System.IO.Streams.Internal (InputStream (..), OutputStream, fromGenerator, makeInputStream, makeOutputStream, read, unRead, write, yield) ------------------------------------------------------------------------------ -- | A side-effecting fold over an 'OutputStream', as a stream transformer. -- -- The IO action returned by 'outputFoldM' can be used to fetch the updated -- seed value. Example: -- -- @ -- ghci> is <- Streams.'System.IO.Streams.List.fromList' [1, 2, 3::Int] -- ghci> (os, getList) <- Streams.'System.IO.Streams.List.listOutputStream' -- ghci> (os', getSeed) \<- Streams.'outputFoldM' (\\x y -> return (x+y)) 0 os -- ghci> Streams.'System.IO.Streams.connect' is os' -- ghci> getList -- [1,2,3] -- ghci> getSeed -- 6 -- @ outputFoldM :: (a -> b -> IO a) -- ^ fold function -> 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. outputFoldM f initial stream = do ref <- newIORef initial os <- makeOutputStream (wr ref) return (os, fetch ref) where wr _ Nothing = write Nothing stream wr ref mb@(Just x) = do !z <- readIORef ref !z' <- f z x writeIORef ref z' write mb stream fetch ref = atomicModifyIORef ref $ \x -> (initial, x) ------------------------------------------------------------------------------ -- | 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 -- value. Example: -- -- @ -- ghci> is <- Streams.'System.IO.Streams.List.fromList' [1, 2, 3::Int] -- ghci> (is', getSeed) \<- Streams.'inputFoldM' (\\x y -> return (x+y)) 0 is -- ghci> Streams.'System.IO.Streams.List.toList' is' -- [1,2,3] -- ghci> getSeed -- 6 -- @ inputFoldM :: (a -> b -> IO a) -- ^ fold function -> 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. inputFoldM f initial stream = do ref <- newIORef initial is <- makeInputStream (rd ref) return (is, fetch ref) where twiddle _ Nothing = return Nothing twiddle ref mb@(Just x) = do !z <- readIORef ref !z' <- f z x writeIORef ref z' return mb rd ref = read stream >>= twiddle ref fetch ref = atomicModifyIORef ref $ \x -> (initial, x) ------------------------------------------------------------------------------ -- | A left fold over an input stream. The input stream is fully consumed. See -- 'Prelude.foldl'. -- -- Example: -- -- @ -- ghci> Streams.'System.IO.Streams.fromList' [1..10] >>= Streams.'fold' (+) 0 -- 55 -- @ fold :: (s -> a -> s) -- ^ fold function -> s -- ^ initial seed -> InputStream a -- ^ input stream -> IO s fold f seed stream = go seed where go !s = read stream >>= maybe (return s) (go . f s) ------------------------------------------------------------------------------ -- | A side-effecting left fold over an input stream. The input stream is fully -- consumed. See 'Prelude.foldl'. -- -- Example: -- -- @ -- ghci> Streams.'System.IO.Streams.fromList' [1..10] >>= Streams.'foldM' (\x y -> 'return' (x + y)) 0 -- 55 -- @ foldM :: (s -> a -> IO s) -- ^ fold function -> s -- ^ initial seed -> InputStream a -- ^ input stream -> IO s foldM f seed stream = go seed where go !s = read stream >>= maybe (return s) ((go =<<) . f s) ------------------------------------------------------------------------------ -- | @any predicate stream@ returns 'True' if any element in @stream@ matches -- the predicate. -- -- 'any' consumes as few elements as possible, ending consumption if an element -- satisfies the predicate. -- -- @ -- ghci> is <- Streams.'System.IO.Streams.List.fromList' [1, 2, 3] -- ghci> Streams.'System.IO.Streams.Combinators.any' (> 0) is -- Consumes one element -- True -- ghci> Streams.'System.IO.Streams.read' is -- Just 2 -- ghci> Streams.'System.IO.Streams.Combinators.any' even is -- Only 3 remains -- False -- @ any :: (a -> Bool) -> InputStream a -> IO Bool any predicate stream = go where go = do mElem <- read stream case mElem of Nothing -> return False Just e -> if predicate e then return True else go ------------------------------------------------------------------------------ -- | @all predicate stream@ returns 'True' if every element in @stream@ matches -- the predicate. -- -- 'all' consumes as few elements as possible, ending consumption if any element -- fails the predicate. -- -- @ -- ghci> is <- Streams.'System.IO.Streams.List.fromList' [1, 2, 3] -- ghci> Streams.'System.IO.Streams.Combinators.all' (< 0) is -- Consumes one element -- False -- ghci> Streams.'System.IO.Streams.read' is -- Just 2 -- ghci> Streams.'System.IO.Streams.Combinators.all' odd is -- Only 3 remains -- True -- @ all :: (a -> Bool) -> InputStream a -> IO Bool all predicate stream = go where go = do mElem <- read stream case mElem of Nothing -> return True Just e -> if predicate e then go else return False ------------------------------------------------------------------------------ -- | @maximum stream@ returns the greatest element in @stream@ or 'Nothing' if -- the stream is empty. -- -- 'maximum' consumes the entire stream. -- -- @ -- ghci> is <- Streams.'System.IO.Streams.List.fromList' [1, 2, 3] -- ghci> Streams.'System.IO.Streams.Combinators.maximum' is -- 3 -- ghci> Streams.'System.IO.Streams.read' is -- The stream is now empty -- Nothing -- @ maximum :: (Ord a) => InputStream a -> IO (Maybe a) maximum stream = do mElem0 <- read stream case mElem0 of Nothing -> return Nothing Just e -> go e where go oldElem = do mElem <- read stream case mElem of Nothing -> return (Just oldElem) Just newElem -> go (max oldElem newElem) ------------------------------------------------------------------------------ -- | @minimum stream@ returns the greatest element in @stream@ -- -- 'minimum' consumes the entire stream. -- -- @ -- ghci> is <- Streams.'System.IO.Streams.List.fromList' [1, 2, 3] -- ghci> Streams.'System.IO.Streams.Combinators.minimum' is -- 1 -- ghci> Streams.'System.IO.Streams.read' is -- The stream is now empty -- Nothing -- @ minimum :: (Ord a) => InputStream a -> IO (Maybe a) minimum stream = do mElem0 <- read stream case mElem0 of Nothing -> return Nothing Just e -> go e where go oldElem = do mElem <- read stream case mElem of Nothing -> return (Just oldElem) Just newElem -> go (min oldElem newElem) ------------------------------------------------------------------------------ -- | @unfoldM f seed@ builds an 'InputStream' from successively applying @f@ to -- the @seed@ value, continuing if @f@ produces 'Just' and halting on -- 'Nothing'. -- -- @ -- ghci> is \<- Streams.'System.IO.Streams.Combinators.unfoldM' (\n -> return $ if n < 3 then Just (n, n + 1) else Nothing) 0 -- ghci> Streams.'System.IO.Streams.List.toList' is -- [0,1,2] -- @ unfoldM :: (b -> IO (Maybe (a, b))) -> b -> IO (InputStream a) unfoldM f seed = fromGenerator (go seed) where go oldSeed = do m <- liftIO (f oldSeed) case m of Nothing -> return $! () Just (a, newSeed) -> do yield a go newSeed ------------------------------------------------------------------------------ -- | Maps a pure function over an 'InputStream'. -- -- @map f s@ passes all output from @s@ through the function @f@. -- -- Satisfies the following laws: -- -- @ -- Streams.'map' (g . f) === Streams.'map' f >=> Streams.'map' g -- Streams.'map' 'id' === Streams.'makeInputStream' . Streams.'read' -- @ map :: (a -> b) -> InputStream a -> IO (InputStream b) map f s = makeInputStream g where g = read s >>= return . fmap f ------------------------------------------------------------------------------ -- | Maps an impure function over an 'InputStream'. -- -- @mapM f s@ passes all output from @s@ through the IO action @f@. -- -- Satisfies the following laws: -- -- @ -- Streams.'mapM' (f >=> g) === Streams.'mapM' f >=> Streams.'mapM' g -- Streams.'mapM' 'return' === Streams.'makeInputStream' . Streams.'read' -- @ -- mapM :: (a -> IO b) -> InputStream a -> IO (InputStream b) mapM f s = makeInputStream g where g = do mb <- read s >>= maybe (return Nothing) (\x -> liftM Just $ f x) return mb ------------------------------------------------------------------------------ -- | Maps a side effect over an 'InputStream'. -- -- @mapM_ f s@ produces a new input stream that passes all output from @s@ -- through the side-effecting IO action @f@. -- -- Example: -- -- @ -- ghci> Streams.'System.IO.Streams.fromList' [1,2,3] >>= -- Streams.'mapM_' ('putStrLn' . 'show' . (*2)) >>= -- Streams.'System.IO.Streams.toList' -- 2 -- 4 -- 6 -- [1,2,3] -- @ -- mapM_ :: (a -> IO b) -> InputStream a -> IO (InputStream a) mapM_ f s = makeInputStream $ do mb <- read s _ <- maybe (return $! ()) (void . f) mb return mb ------------------------------------------------------------------------------ -- | Contravariant counterpart to 'map'. -- -- @contramap f s@ passes all input to @s@ through the function @f@. -- -- Satisfies the following laws: -- -- @ -- Streams.'contramap' (g . f) === Streams.'contramap' g >=> Streams.'contramap' f -- Streams.'contramap' 'id' === 'return' -- @ contramap :: (a -> b) -> OutputStream b -> IO (OutputStream a) contramap f s = makeOutputStream $ flip write s . fmap f ------------------------------------------------------------------------------ -- | Contravariant counterpart to 'mapM'. -- -- @contramapM f s@ passes all input to @s@ through the IO action @f@ -- -- Satisfies the following laws: -- -- @ -- Streams.'contramapM' (f >=> g) = Streams.'contramapM' g >=> Streams.'contramapM' f -- Streams.'contramapM' 'return' = 'return' -- @ contramapM :: (a -> IO b) -> OutputStream b -> IO (OutputStream a) contramapM f s = makeOutputStream g where g Nothing = write Nothing s g (Just x) = do !y <- f x write (Just y) s ------------------------------------------------------------------------------ -- | Equivalent to 'mapM_' for output. -- -- @contramapM f s@ passes all input to @s@ through the side-effecting IO -- action @f@. -- contramapM_ :: (a -> IO b) -> OutputStream a -> IO (OutputStream a) contramapM_ f s = makeOutputStream $ \mb -> do _ <- maybe (return $! ()) (void . f) mb write mb s ------------------------------------------------------------------------------ -- | Drives an 'InputStream' to end-of-stream, discarding all of the yielded -- values. skipToEof :: InputStream a -> IO () skipToEof str = go where go = read str >>= maybe (return $! ()) (const go) {-# INLINE skipToEof #-} ------------------------------------------------------------------------------ -- | Drops chunks from an input stream if they fail to match a given filter -- predicate. See 'Prelude.filter'. -- -- Items pushed back to the returned stream are propagated back upstream. -- -- Example: -- -- @ -- ghci> Streams.'System.IO.Streams.fromList' [\"the\", \"quick\", \"brown\", \"fox\"] >>= -- Streams.'filterM' ('return' . (/= \"brown\")) >>= Streams.'System.IO.Streams.toList' -- [\"the\",\"quick\",\"fox\"] -- @ filterM :: (a -> IO Bool) -> InputStream a -> IO (InputStream a) filterM p src = return $! InputStream prod pb where prod = read src >>= maybe eof chunk chunk s = do b <- p s if b then return $! Just s else prod eof = return Nothing pb s = unRead s src ------------------------------------------------------------------------------ -- | Drops chunks from an input stream if they fail to match a given filter -- predicate. See 'Prelude.filter'. -- -- Items pushed back to the returned stream are propagated back upstream. -- -- Example: -- -- @ -- ghci> Streams.'System.IO.Streams.fromList' [\"the\", \"quick\", \"brown\", \"fox\"] >>= -- Streams.'filter' (/= \"brown\") >>= Streams.'System.IO.Streams.toList' -- [\"the\",\"quick\",\"fox\"] -- @ filter :: (a -> Bool) -> InputStream a -> IO (InputStream a) filter p src = return $! InputStream prod pb where prod = read src >>= maybe eof chunk chunk s = do let b = p s if b then return $! Just s else prod eof = return Nothing pb s = unRead s src ------------------------------------------------------------------------------ -- | The function @intersperse v s@ wraps the 'OutputStream' @s@, creating a -- new output stream that writes its input to @s@ interspersed with the -- provided value @v@. See 'Data.List.intersperse'. -- -- Example: -- -- @ -- ghci> import Control.Monad ((>=>)) -- ghci> is <- Streams.'System.IO.Streams.List.fromList' [\"nom\", \"nom\", \"nom\"::'ByteString'] -- ghci> Streams.'System.IO.Streams.List.outputToList' (Streams.'intersperse' \"burp!\" >=> Streams.'System.IO.Streams.connect' is) -- [\"nom\",\"burp!\",\"nom\",\"burp!\",\"nom\"] -- @ intersperse :: a -> OutputStream a -> IO (OutputStream a) intersperse sep os = newIORef False >>= makeOutputStream . f where f _ Nothing = write Nothing os f sendRef s = do b <- readIORef sendRef writeIORef sendRef True when b $ write (Just sep) os write s os ------------------------------------------------------------------------------ -- | Combines two input streams. Continues yielding elements from both input -- streams until one of them finishes. zip :: InputStream a -> InputStream b -> IO (InputStream (a, b)) zip src1 src2 = makeInputStream src where src = read src1 >>= (maybe (return Nothing) $ \a -> read src2 >>= (maybe (unRead a src1 >> return Nothing) $ \b -> return $! Just $! (a, b))) ------------------------------------------------------------------------------ -- | Combines two input streams using the supplied function. Continues yielding -- elements from both input streams until one of them finishes. zipWith :: (a -> b -> c) -> InputStream a -> InputStream b -> IO (InputStream c) zipWith f src1 src2 = makeInputStream src where src = read src1 >>= (maybe (return Nothing) $ \a -> read src2 >>= (maybe (unRead a src1 >> return Nothing) $ \b -> return $! Just $! f a b ) ) ------------------------------------------------------------------------------ -- | Combines two input streams using the supplied monadic function. Continues -- yielding elements from both input streams until one of them finishes. zipWithM :: (a -> b -> IO c) -> InputStream a -> InputStream b -> IO (InputStream c) zipWithM f src1 src2 = makeInputStream src where src = read src1 >>= (maybe (return Nothing) $ \a -> read src2 >>= (maybe (unRead a src1 >> return Nothing) $ \b -> f a b >>= \c -> return $! Just $! c ) ) ------------------------------------------------------------------------------ -- | Filters output to be sent to the given 'OutputStream' using a pure -- function. See 'filter'. -- -- Example: -- -- @ -- ghci> import qualified "Data.ByteString.Char8" as S -- ghci> os1 \<- Streams.'System.IO.Streams.stdout' >>= Streams.'System.IO.Streams.unlines -- ghci> os2 \<- os1 >>= Streams.'contramap' (S.pack . show) >>= Streams.'filterOutput' even -- ghci> Streams.'write' (Just 3) os2 -- ghci> Streams.'write' (Just 4) os2 -- 4 -- @ {- Note: The example is a lie, because unlines has weird behavior -} filterOutput :: (a -> Bool) -> OutputStream a -> IO (OutputStream a) filterOutput p output = makeOutputStream chunk where chunk Nothing = write Nothing output chunk ch@(Just x) = when (p x) $ write ch output ------------------------------------------------------------------------------ -- | Filters output to be sent to the given 'OutputStream' using a predicate -- function in IO. See 'filterM'. -- -- Example: -- -- @ -- ghci> let check a = putStrLn a ("Allow " ++ show a ++ "?") >> readLn :: IO Bool -- ghci> import qualified Data.ByteString.Char8 as S -- ghci> os1 <- Streams.'System.IO.Streams.unlines' Streams.'System.IO.Streams.stdout' -- ghci> os2 \<- os1 >>= Streams.'contramap' (S.pack . show) >>= Streams.'filterOutputM' check -- ghci> Streams.'System.IO.Streams.write' (Just 3) os2 -- Allow 3? -- False\ -- ghci> Streams.'System.IO.Streams.write' (Just 4) os2 -- Allow 4? -- True\ -- 4 -- @ filterOutputM :: (a -> IO Bool) -> OutputStream a -> IO (OutputStream a) filterOutputM p output = makeOutputStream chunk where chunk Nothing = write Nothing output chunk ch@(Just x) = do b <- p x if b then write ch output else return $! () ------------------------------------------------------------------------------ -- | Takes apart a stream of pairs, producing a pair of input streams. Reading -- from either of the produced streams will cause a pair of values to be pulled -- from the original stream if necessary. Note that reading @n@ values from one -- of the returned streams will cause @n@ values to be buffered at the other -- stream. -- -- Access to the original stream is thread safe, i.e. guarded by a lock. unzip :: InputStream (a, b) -> IO (InputStream a, InputStream b) unzip os = do lock <- newMVar $! () buf1 <- newIORef id buf2 <- newIORef id is1 <- makeInputStream $ src lock id buf1 buf2 is2 <- makeInputStream $ src lock twist buf2 buf1 return (is1, is2) where twist (a, b) = (b, a) src lock proj myBuf theirBuf = withMVar lock $ const $ do dl <- readIORef myBuf case dl [] of [] -> more (x:xs) -> writeIORef myBuf (xs++) >> (return $! Just x) where more = read os >>= maybe (return Nothing) (\x -> do let (a, b) = proj x modifyIORef theirBuf (. (b:)) return $! Just a) ------------------------------------------------------------------------------ -- | Wraps an 'InputStream', producing a new 'InputStream' that will produce at -- most @n@ items, subsequently yielding end-of-stream forever. -- -- Items pushed back to the returned 'InputStream' will be propagated upstream, -- modifying the count of taken items accordingly. -- -- Example: -- -- @ -- ghci> is <- Streams.'fromList' [1..9::Int] -- ghci> is' <- Streams.'take' 1 is -- ghci> Streams.'read' is' -- Just 1 -- ghci> Streams.'read' is' -- Nothing -- ghci> Streams.'System.IO.Streams.peek' is -- Just 2 -- ghci> Streams.'unRead' 11 is' -- ghci> Streams.'System.IO.Streams.peek' is -- Just 11 -- ghci> Streams.'System.IO.Streams.peek' is' -- Just 11 -- ghci> Streams.'read' is' -- Just 11 -- ghci> Streams.'read' is' -- Nothing -- ghci> Streams.'read' is -- Just 2 -- ghci> Streams.'toList' is -- [3,4,5,6,7,8,9] -- @ -- take :: Int64 -> InputStream a -> IO (InputStream a) take k0 input = do kref <- newIORef k0 return $! InputStream (prod kref) (pb kref) where prod kref = do !k <- readIORef kref if k <= 0 then return Nothing else do m <- read input when (isJust m) $ modifyIORef kref $ \x -> x - 1 return m pb kref !s = do unRead s input modifyIORef kref (+1) ------------------------------------------------------------------------------ -- | Wraps an 'InputStream', producing a new 'InputStream' that will drop the -- first @n@ items produced by the wrapped stream. See 'Prelude.drop'. -- -- Items pushed back to the returned 'InputStream' will be propagated upstream, -- modifying the count of dropped items accordingly. drop :: Int64 -> InputStream a -> IO (InputStream a) drop k0 input = do kref <- newIORef k0 return $! InputStream (prod kref) (pb kref) where prod kref = do !k <- readIORef kref if k <= 0 then getInput kref else discard kref getInput kref = do read input >>= maybe (return Nothing) (\c -> do modifyIORef kref (\x -> x - 1) return $! Just c) discard kref = getInput kref >>= maybe (return Nothing) (const $ prod kref) pb kref s = do unRead s input modifyIORef kref (+1) ------------------------------------------------------------------------------ -- | Wraps an 'OutputStream', producing a new 'OutputStream' that will pass at -- most @n@ items on to the wrapped stream, subsequently ignoring the rest of -- the input. -- give :: Int64 -> OutputStream a -> IO (OutputStream a) give k output = newIORef k >>= makeOutputStream . chunk where chunk ref = maybe (return $! ()) $ \x -> do !n <- readIORef ref if n <= 0 then return $! () else do writeIORef ref $! n - 1 write (Just x) output ------------------------------------------------------------------------------ -- | Wraps an 'OutputStream', producing a new 'OutputStream' that will ignore -- the first @n@ items received, subsequently passing the rest of the input on -- to the wrapped stream. -- ignore :: Int64 -> OutputStream a -> IO (OutputStream a) ignore k output = newIORef k >>= makeOutputStream . chunk where chunk ref = maybe (return $! ()) $ \x -> do !n <- readIORef ref if n > 0 then writeIORef ref $! n - 1 else write (Just x) output ------------------------------------------------------------------------------ -- | Wraps an 'OutputStream', ignoring any end-of-stream 'Nothing' values -- written to the returned stream. -- -- /Since: 1.0.1.0/ -- ignoreEof :: OutputStream a -> IO (OutputStream a) ignoreEof s = makeOutputStream f where f Nothing = return $! () f x = write x s ------------------------------------------------------------------------------ -- | Wraps an 'InputStream', running the specified action when the stream -- yields end-of-file. -- -- /Since: 1.0.2.0/ -- atEndOfInput :: IO b -> InputStream a -> IO (InputStream a) atEndOfInput m is = return $! InputStream prod pb where prod = read is >>= maybe eof (return . Just) eof = void m >> return Nothing pb s = unRead s is ------------------------------------------------------------------------------ -- | Wraps an 'OutputStream', running the specified action when the stream -- receives end-of-file. -- -- /Since: 1.0.2.0/ -- atEndOfOutput :: IO b -> OutputStream a -> IO (OutputStream a) atEndOfOutput m os = makeOutputStream f where f Nothing = write Nothing os >> void m f x = write x os io-streams-1.1.2.2/src/System/IO/Streams/List.hs0000644000000000000000000001276112251607076017410 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} -- | List conversions and utilities. module System.IO.Streams.List ( -- * List conversions fromList , toList , outputToList , writeList -- * Utility , chunkList , concatLists , listOutputStream ) where import Control.Concurrent.MVar (modifyMVar, modifyMVar_, newMVar) import Control.Monad.IO.Class (MonadIO (..)) import Data.IORef (newIORef, readIORef, writeIORef) import Prelude hiding (read) import System.IO.Streams.Internal (InputStream, OutputStream, await, connect, fromConsumer, fromGenerator, makeInputStream, read, write, yield) ------------------------------------------------------------------------------ -- | Transforms a list into an 'InputStream' that produces no side effects. -- -- @ -- ghci> is <- Streams.'fromList' [1, 2] -- ghci> 'replicateM' 3 (Streams.'read' is) -- [Just 1, Just 2, Nothing] -- @ fromList :: [c] -> IO (InputStream c) fromList inp = newIORef inp >>= makeInputStream . f where f ref = readIORef ref >>= \l -> case l of [] -> return Nothing (x:xs) -> writeIORef ref xs >> return (Just x) {-# INLINE fromList #-} ------------------------------------------------------------------------------ -- | 'listOutputStream' returns an 'OutputStream' which stores values fed into -- it and an action which flushes all stored values to a list. -- -- The flush action resets the store. -- -- Note that this function /will/ buffer any input sent to it on the heap. -- Please don't use this unless you're sure that the amount of input provided -- is bounded and will fit in memory without issues. -- -- @ -- ghci> (os, flush) <- Streams.'listOutputStream' :: IO ('OutputStream' Int, IO [Int]) -- ghci> Streams.'writeList' [1, 2] os -- ghci> flush -- [1, 2] -- ghci> Streams.'writeList' [3, 4] os -- ghci> flush -- [3, 4] -- @ listOutputStream :: IO (OutputStream c, IO [c]) listOutputStream = do r <- newMVar id c <- fromConsumer $ consumer r return (c, flush r) where consumer r = go where go = await >>= (maybe (return $! ()) $ \c -> do liftIO $ modifyMVar_ r $ \dl -> return (dl . (c:)) go) flush r = modifyMVar r $ \dl -> return (id, dl []) {-# INLINE listOutputStream #-} ------------------------------------------------------------------------------ -- | Drains an 'InputStream', converting it to a list. N.B. that this function -- reads the entire 'InputStream' strictly into memory and as such is not -- recommended for streaming applications or where the size of the input is not -- bounded or known. -- -- @ -- ghci> is <- Streams.'fromList' [1, 2] -- ghci> Streams.'toList' is -- [1, 2] -- @ toList :: InputStream a -> IO [a] toList is = outputToList (connect is) {-# INLINE toList #-} ------------------------------------------------------------------------------ -- | Given an IO action that requires an 'OutputStream', creates one and -- captures all the output the action sends to it as a list. -- -- Example: -- -- @ -- ghci> import "Control.Applicative" -- ghci> ('connect' <$> 'fromList' [\"a\", \"b\", \"c\"]) >>= 'outputToList' -- [\"a\",\"b\",\"c\"] -- @ outputToList :: (OutputStream a -> IO b) -> IO [a] outputToList f = do (os, getList) <- listOutputStream _ <- f os getList {-# INLINE outputToList #-} ------------------------------------------------------------------------------ -- | Feeds a list to an 'OutputStream'. Does /not/ write an end-of-stream to -- the stream. -- -- @ -- ghci> os \<- Streams.'unlines' Streams.'System.IO.Streams.stdout' >>= Streams.'System.IO.Streams.contramap' (S.pack . show) :: IO ('OutputStream' Int) -- ghci> Streams.'writeList' [1, 2] os -- 1 -- 2 -- ghci> Streams.'writeList' [3, 4] os -- 3 -- 4 -- @ writeList :: [a] -> OutputStream a -> IO () writeList xs os = mapM_ (flip write os . Just) xs {-# INLINE writeList #-} ------------------------------------------------------------------------------ -- | Splits an input stream into chunks of at most size @n@. -- -- Example: -- -- @ -- ghci> 'fromList' [1..14::Int] >>= 'chunkList' 4 >>= 'toList' -- [[1,2,3,4],[5,6,7,8],[9,10,11,12],[13,14]] -- @ chunkList :: Int -- ^ chunk size -> InputStream a -- ^ stream to process -> IO (InputStream [a]) chunkList n input = if n <= 0 then error $ "chunkList: bad size: " ++ show n else fromGenerator $ go n id where go !k dl | k <= 0 = yield (dl []) >> go n 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 (k - 1) (dl . (x:)) ------------------------------------------------------------------------------ -- | Given an input stream containing lists, produces a new input stream that -- will yield the concatenation of these lists. See 'Prelude.concat'. -- -- Example: -- -- @ -- ghci> Streams.'fromList' [[1,2,3::Int], [4,5,6]] >>= -- Streams.'concatLists' >>= -- Streams.'toList' -- [1,2,3,4,5,6] -- @ concatLists :: InputStream [a] -> IO (InputStream a) concatLists input = fromGenerator go where go = liftIO (read input) >>= maybe (return $! ()) chunk chunk l = sequence_ (map yield l) >> go io-streams-1.1.2.2/src/System/IO/Streams/Network.hs0000644000000000000000000000427512251607076020127 0ustar0000000000000000-- | Converting network 'Socket's to streams. module System.IO.Streams.Network ( -- * Sockets to Streams socketToStreams , socketToStreamsWithBufferSize ) where ------------------------------------------------------------------------------ import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as S import Foreign.Storable (sizeOf) import Network.Socket (Socket) import qualified Network.Socket.ByteString as N import System.IO.Streams.Internal (InputStream, OutputStream) import qualified System.IO.Streams.Internal as Streams ------------------------------------------------------------------------------ bUFSIZ :: Int bUFSIZ = 8192 - overhead where overhead = 4 * (sizeOf $! (0 :: Int)) ------------------------------------------------------------------------------ -- | Converts a 'Socket' to an 'InputStream' \/ 'OutputStream' pair. Note that, -- as is usually the case in @io-streams@, writing a 'Nothing' to the generated -- 'OutputStream' does not cause the underlying 'Socket' to be closed. socketToStreams :: Socket -> IO (InputStream ByteString, OutputStream ByteString) socketToStreams = socketToStreamsWithBufferSize bUFSIZ ------------------------------------------------------------------------------ -- | Converts a 'Socket' to an 'InputStream' \/ 'OutputStream' pair, with -- control over the size of the receive buffers. Note that, as is usually the -- case in @io-streams@, writing a 'Nothing' to the generated 'OutputStream' -- does not cause the underlying 'Socket' to be closed. socketToStreamsWithBufferSize :: Int -- ^ how large the receive buffer should be -> Socket -- ^ network socket -> IO (InputStream ByteString, OutputStream ByteString) socketToStreamsWithBufferSize bufsiz socket = do is <- Streams.makeInputStream input os <- Streams.makeOutputStream output return $! (is, os) where input = do s <- N.recv socket bufsiz return $! if S.null s then Nothing else Just s output Nothing = return $! () output (Just s) = if S.null s then return $! () else N.sendAll socket s io-streams-1.1.2.2/src/System/IO/Streams/Text.hs0000644000000000000000000001314512251607076017416 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} -- | Stream primitives for decoding and encoding 'Text' values in UTF-8 format. module System.IO.Streams.Text ( -- * Decoders and Encoders decodeUtf8 , decodeUtf8With , encodeUtf8 ) where ------------------------------------------------------------------------------ import Control.Monad (when) import Control.Monad.IO.Class (MonadIO (..)) import Data.ByteString (ByteString) import qualified Data.ByteString as S import qualified Data.ByteString.Unsafe as S import Data.Monoid (mappend) import Data.Text (Text) import qualified Data.Text.Encoding as T import Data.Text.Encoding.Error (OnDecodeError) import Data.Word (Word8) ------------------------------------------------------------------------------ import qualified System.IO.Streams.Combinators as Streams import System.IO.Streams.Internal (InputStream, OutputStream) import qualified System.IO.Streams.Internal as Streams ------------------------------------------------------------------------------ -- | Convert an 'OutputStream' taking 'ByteString's to an 'OutputStream' that -- takes 'Text', encoding the data as UTF-8. See -- @Data.Text.Encoding.'T.encodeUtf8'@. encodeUtf8 :: OutputStream ByteString -> IO (OutputStream Text) encodeUtf8 = Streams.contramap T.encodeUtf8 ------------------------------------------------------------------------------ -- | Decode an 'InputStream' of 'ByteString's in UTF-8 format into an -- 'InputStream' of 'Text' values. If decoding fails, will throw an exception. -- See @Data.Text.Encoding.'T.decodeUtf8'@. decodeUtf8 :: InputStream ByteString -> IO (InputStream Text) decodeUtf8 = decode T.decodeUtf8 {-# INLINE decodeUtf8 #-} ------------------------------------------------------------------------------ -- | Decode an 'InputStream' of 'ByteString's in UTF-8 format into an -- 'InputStream' of 'Text' values. If decoding fails, invokes the given -- 'OnDecodeError' function to decide what to do. See -- @Data.Text.Encoding.'T.decodeUtf8With'@. decodeUtf8With :: OnDecodeError -> InputStream ByteString -> IO (InputStream Text) decodeUtf8With e = decode (T.decodeUtf8With e) {-# INLINE decodeUtf8With #-} ------------------------------------------------------------------------------ decode :: (ByteString -> Text) -> InputStream ByteString -> IO (InputStream Text) decode decodeFunc input = Streams.fromGenerator $ go Nothing where go !soFar = liftIO (Streams.read input) >>= maybe (finish soFar) (chunk soFar) finish Nothing = return $! () finish (Just x) = Streams.yield $! decodeFunc x chunk Nothing s = process s chunk (Just a) b = process $ a `mappend` b process !s = case findLastFullCode s of LastCodeIsComplete x -> (Streams.yield $! decodeFunc x) >> go Nothing Split a b -> do when (not $ S.null a) $ Streams.yield $! decodeFunc a go (Just b) NoCodesAreComplete x -> go (Just x) ------------------------------------------------------------------------------ data ByteType = Regular | Continuation | Start !Int ------------------------------------------------------------------------------ between :: Word8 -> Word8 -> Word8 -> Bool between x y z = x >= y && x <= z {-# INLINE between #-} ------------------------------------------------------------------------------ characterizeByte :: Word8 -> ByteType characterizeByte c | between c 0 0x7F = Regular | between c 0x80 0xBF = Continuation | between c 0xC0 0xDF = Start 1 | between c 0xE0 0xEF = Start 2 -- Technically utf-8 ends after 0xf4, but those sequences -- won't decode anyways. | otherwise = Start 3 ------------------------------------------------------------------------------ data FindOutput = LastCodeIsComplete !ByteString | Split !ByteString !ByteString | NoCodesAreComplete !ByteString -- should be impossibly rare -- in real data ------------------------------------------------------------------------------ findLastFullCode :: ByteString -> FindOutput findLastFullCode b | len == 0 = LastCodeIsComplete b | otherwise = go where len = S.length b go = let !idx = len - 1 !c = S.unsafeIndex b idx in case characterizeByte c of Regular -> LastCodeIsComplete b Continuation -> cont (len - 2) _ -> Split (S.unsafeTake idx b) (S.unsafeDrop idx b) cont !idx | idx < 0 = NoCodesAreComplete b | otherwise = let !c = S.unsafeIndex b idx in case characterizeByte c of -- what do we do with this? decoding will fail. give up -- and lie, the text decoder will deal with it.. Regular -> LastCodeIsComplete b Continuation -> cont (idx - 1) Start n -> if n + idx == len - 1 then LastCodeIsComplete b else Split (S.unsafeTake idx b) (S.unsafeDrop idx b) {-# INLINE findLastFullCode #-} io-streams-1.1.2.2/src/System/IO/Streams/Process.hs0000644000000000000000000000731512251607076020112 0ustar0000000000000000-- | A module adapting the functions from "System.Process" to work with -- @io-streams@. module System.IO.Streams.Process ( module System.Process , runInteractiveCommand , runInteractiveProcess ) where ------------------------------------------------------------------------------ import Data.ByteString.Char8 (ByteString) import System.IO (hClose) import qualified System.IO.Streams.Combinators as Streams import qualified System.IO.Streams.Handle as Streams import System.IO.Streams.Internal (InputStream, OutputStream) import qualified System.IO.Streams.Internal as Streams import System.Process hiding (env, runInteractiveCommand, runInteractiveProcess, runProcess) import qualified System.Process as P ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- | Runs a command using the shell, and returns streams that may be used to -- communicate with the process via its stdin, stdout, and stderr respectively. -- -- The streams returned by this command are guarded by locks and are therefore -- safe to use in multithreaded code. -- -- /Since: 1.0.2.0/ -- runInteractiveCommand :: String -> IO (OutputStream ByteString, InputStream ByteString, InputStream ByteString, ProcessHandle) runInteractiveCommand scmd = do (hin, hout, herr, ph) <- P.runInteractiveCommand scmd sIn <- Streams.handleToOutputStream hin >>= Streams.atEndOfOutput (hClose hin) >>= Streams.lockingOutputStream sOut <- Streams.handleToInputStream hout >>= Streams.atEndOfInput (hClose hout) >>= Streams.lockingInputStream sErr <- Streams.handleToInputStream herr >>= Streams.atEndOfInput (hClose herr) >>= Streams.lockingInputStream return (sIn, sOut, sErr, ph) ------------------------------------------------------------------------------ -- | Runs a raw command, and returns streams that may be used to communicate -- with the process via its @stdin@, @stdout@ and @stderr@ respectively. -- -- For example, to start a process and feed a string to its stdin: -- -- > (inp,out,err,pid) <- runInteractiveProcess "..." -- > forkIO (Streams.write (Just str) inp) -- -- The streams returned by this command are guarded by locks and are therefore -- safe to use in multithreaded code. -- -- /Since: 1.0.2.0/ -- runInteractiveProcess :: FilePath -- ^ Filename of the executable (see 'proc' for details) -> [String] -- ^ Arguments to pass to the executable -> Maybe FilePath -- ^ Optional path to the working directory -> Maybe [(String,String)] -- ^ Optional environment (otherwise inherit) -> IO (OutputStream ByteString, InputStream ByteString, InputStream ByteString, ProcessHandle) runInteractiveProcess cmd args wd env = do (hin, hout, herr, ph) <- P.runInteractiveProcess cmd args wd env sIn <- Streams.handleToOutputStream hin >>= Streams.atEndOfOutput (hClose hin) >>= Streams.lockingOutputStream sOut <- Streams.handleToInputStream hout >>= Streams.atEndOfInput (hClose hout) >>= Streams.lockingInputStream sErr <- Streams.handleToInputStream herr >>= Streams.atEndOfInput (hClose herr) >>= Streams.lockingInputStream return (sIn, sOut, sErr, ph) io-streams-1.1.2.2/src/System/IO/Streams/Handle.hs0000644000000000000000000001273512251607076017671 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif -- | Input and output streams for file 'Handle's. module System.IO.Streams.Handle ( -- * Handle conversions handleToInputStream , handleToOutputStream , inputStreamToHandle , outputStreamToHandle , streamPairToHandle -- * Standard system handles , stdin , stdout , stderr ) where import Data.ByteString (ByteString) import qualified Data.ByteString as S import qualified GHC.IO.Handle as H import System.IO (Handle, hFlush) import qualified System.IO as IO import System.IO.Unsafe (unsafePerformIO) ------------------------------------------------------------------------------ import System.IO.Streams.Internal (InputStream, OutputStream, SP (..), lockingInputStream, lockingOutputStream, makeInputStream, makeOutputStream) ------------------------------------------------------------------------------ bUFSIZ :: Int bUFSIZ = 32752 ------------------------------------------------------------------------------ -- | Converts a read-only handle into an 'InputStream' of strict 'ByteString's. -- -- Note that the wrapped handle is /not/ closed when it yields end-of-stream; -- you can use 'System.IO.Streams.Combinators.atEndOfInput' to close the handle -- if you would like this behaviour. handleToInputStream :: Handle -> IO (InputStream ByteString) handleToInputStream h = makeInputStream f where f = do x <- S.hGetSome h bUFSIZ return $! if S.null x then Nothing else Just x ------------------------------------------------------------------------------ -- | Converts a writable handle into an '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. handleToOutputStream :: Handle -> IO (OutputStream ByteString) handleToOutputStream h = makeOutputStream f where f Nothing = hFlush h f (Just x) = if S.null x then hFlush h else S.hPut h x ------------------------------------------------------------------------------ -- | 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). -- -- Note: the 'InputStream' passed into this function is wrapped in -- 'lockingInputStream' to make it thread-safe. -- -- /Since: 1.0.2.0./ inputStreamToHandle :: InputStream ByteString -> IO Handle inputStreamToHandle is0 = do is <- lockingInputStream is0 h <- H.mkDuplexHandle is "*input-stream*" Nothing $! H.noNewlineTranslation H.hSetBuffering h H.NoBuffering return h ------------------------------------------------------------------------------ -- | Converts an 'OutputStream' over bytestrings to a write-only 'Handle'. Note -- 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. -- -- Note: the 'OutputStream' passed into this function is wrapped in -- 'lockingOutputStream' to make it thread-safe. -- -- /Since: 1.0.2.0./ outputStreamToHandle :: OutputStream ByteString -> IO Handle outputStreamToHandle os0 = do os <- lockingOutputStream os0 h <- H.mkDuplexHandle os "*output-stream*" Nothing $! H.noNewlineTranslation H.hSetBuffering h H.NoBuffering return $! h ------------------------------------------------------------------------------ -- | Converts a pair of 'InputStream' and 'OutputStream' over bytestrings to a -- read-write 'Handle'. -- -- Note: the streams passed into this function are wrapped in -- locking primitives to make them thread-safe. -- -- /Since: 1.0.2.0./ streamPairToHandle :: InputStream ByteString -> OutputStream ByteString -> IO Handle streamPairToHandle is0 os0 = do is <- lockingInputStream is0 os <- lockingOutputStream os0 h <- H.mkDuplexHandle (SP is os) "*stream*" Nothing $! H.noNewlineTranslation H.hSetBuffering h H.NoBuffering return $! h ------------------------------------------------------------------------------ -- | An 'InputStream' for 'IO.stdin'. stdin :: InputStream ByteString stdin = unsafePerformIO (handleToInputStream IO.stdin >>= lockingInputStream) {-# NOINLINE stdin #-} ------------------------------------------------------------------------------ -- | An 'OutputStream' for 'IO.stdout'. stdout :: OutputStream ByteString stdout = unsafePerformIO (handleToOutputStream IO.stdout >>= lockingOutputStream) {-# NOINLINE stdout #-} ------------------------------------------------------------------------------ -- | An 'OutputStream' for 'IO.stderr'. stderr :: OutputStream ByteString stderr = unsafePerformIO (handleToOutputStream IO.stderr >>= lockingOutputStream) {-# NOINLINE stderr #-} io-streams-1.1.2.2/src/System/IO/Streams/Builder.hs0000644000000000000000000001700412251607076020056 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# 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. -- -- (/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/ -- -- Given an 'OutputStream' taking 'ByteString': -- -- > someOutputStream :: OutputStream ByteString -- -- You create a new output stream wrapping the original one that accepts -- 'Builder' values: -- -- -- @ -- do -- newStream <- Streams.'builderStream' someOutputStream -- Streams.'write' ('Just' $ 'Blaze.ByteString.Builder.fromByteString' \"hello\") newStream -- .... -- @ -- -- -- You can flush the output buffer using 'Blaze.ByteString.Builder.flush': -- -- @ -- .... -- Streams.'write' ('Just' 'Blaze.ByteString.Builder.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. -- -- /Example/ -- -- @ -- example :: IO [ByteString] -- 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 -- is \<- Streams.'System.IO.Streams.fromList' l -- (os0, grab) \<- Streams.'System.IO.Streams.listOutputStream' -- os \<- Streams.'builderStream' os0 -- Streams.'System.IO.Streams.connect' is os >> grab -- -- ghci> example -- [\"the quick brown fox\",\"\",\"jumped over the\"] -- @ -- module System.IO.Streams.Builder ( -- * Blaze builder conversion builderStream , unsafeBuilderStream , builderStreamWith ) where ------------------------------------------------------------------------------ import Blaze.ByteString.Builder.Internal (defaultBufferSize) ------------------------------------------------------------------------------ import Blaze.ByteString.Builder.Internal.Types (BufRange (..), BuildSignal (..), Builder (..), buildStep) ------------------------------------------------------------------------------ import Blaze.ByteString.Builder.Internal.Buffer (Buffer, BufferAllocStrategy, allNewBuffersStrategy, execBuildStep, reuseBufferStrategy, unsafeFreezeBuffer, unsafeFreezeNonEmptyBuffer, updateEndOfSlice) ------------------------------------------------------------------------------ import Control.Monad (when) import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as S import Data.IORef (newIORef, readIORef, writeIORef) ------------------------------------------------------------------------------ import System.IO.Streams.Internal (OutputStream, makeOutputStream, write) ------------------------------------------------------------------------------ -- | Converts a 'ByteString' sink into a 'Builder' sink. -- -- 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. -- builderStream :: OutputStream ByteString -> IO (OutputStream Builder) builderStream = builderStreamWith (allNewBuffersStrategy defaultBufferSize) ------------------------------------------------------------------------------ -- | Unsafe variation on 'builderStream' that reuses an existing buffer for -- efficiency. -- -- /NOTE/: because the buffer is reused, subsequent 'ByteString' values written -- to the wrapped 'OutputString' will cause previous yielded strings to change. -- Do not retain references to these 'ByteString' values inside the -- 'OutputStream' you pass to this function, or you will violate referential -- transparency. -- -- If you /must/ retain copies of these values, then please use -- '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'. -- -- 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' io-streams-1.1.2.2/src/System/IO/Streams/Vector.hs0000644000000000000000000003076312251607076017741 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} -- | Vector conversions and utilities. module System.IO.Streams.Vector ( -- * Vector conversions fromVector , toVector , toVectorSized , outputToVector , outputToVectorSized , toMutableVector , toMutableVectorSized , outputToMutableVector , outputToMutableVectorSized , writeVector -- * Utility , chunkVector , vectorOutputStream , vectorOutputStreamSized , mutableVectorOutputStream , mutableVectorOutputStreamSized ) where ------------------------------------------------------------------------------ import Control.Concurrent.MVar (modifyMVar, modifyMVar_, newMVar) import Control.Monad (liftM, (>=>)) import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Primitive (PrimState (..)) import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.Vector.Generic (Vector (..)) import qualified Data.Vector.Generic as V import Data.Vector.Generic.Mutable (MVector) import qualified Data.Vector.Generic.Mutable as VM import System.IO.Streams.Internal (InputStream, OutputStream, fromGenerator, yield) import qualified System.IO.Streams.Internal as S ------------------------------------------------------------------------------ -- | Transforms a vector into an 'InputStream' that yields each of the values -- in the vector in turn. -- -- @ -- ghci> import "Control.Monad" -- ghci> import qualified "System.IO.Streams" as Streams -- ghci> import qualified "Data.Vector" as V -- ghci> let v = V.'Data.Vector.fromList' [1, 2] -- ghci> is <- Streams.'fromVector' v -- ghci> 'Control.Monad.replicateM' 3 (Streams.'read' is) -- ['Just' 1,'Just' 2,'Nothing'] -- @ fromVector :: Vector v a => v a -> IO (InputStream a) fromVector = fromGenerator . V.mapM_ yield {-# INLINE fromVector #-} ------------------------------------------------------------------------------ -- | Drains an 'InputStream', converting it to a vector. Note that this -- function reads the entire 'InputStream' strictly into memory and as such is -- not recommended for streaming applications or where the size of the input is -- not bounded or known. -- -- @ -- ghci> is <- Streams.'System.IO.Streams.fromList' [(1::Int)..4] -- ghci> Streams.'toVector' is :: 'IO' (V.'Vector' Int) -- fromList [1,2,3,4] -- @ toVector :: Vector v a => InputStream a -> IO (v a) toVector = toVectorSized dEFAULT_BUFSIZ {-# INLINE toVector #-} ------------------------------------------------------------------------------ -- | 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 {-# INLINE toVectorSized #-} ------------------------------------------------------------------------------ -- | Drains an 'InputStream', converting it to a mutable vector. Note that this -- function reads the entire 'InputStream' strictly into memory and as such is -- not recommended for streaming applications or where the size of the input is -- not bounded or known. toMutableVector :: VM.MVector v a => InputStream a -> IO (v (PrimState IO) a) toMutableVector = toMutableVectorSized dEFAULT_BUFSIZ ------------------------------------------------------------------------------ -- | Like 'toMutableVector', but allows control over how large the vector -- buffer is to start with. toMutableVectorSized :: VM.MVector v a => Int -- ^ initial size of the vector buffer -> InputStream a -> IO (v (PrimState IO) a) toMutableVectorSized initialSize input = vfNew initialSize >>= go where go vfi = S.read input >>= maybe (vfFinish vfi) (vfAppend vfi >=> go) {-# INLINE toMutableVectorSized #-} ------------------------------------------------------------------------------ -- | 'vectorOutputStream' returns an 'OutputStream' which stores values fed -- into it and an action which flushes all stored values to a vector. -- -- The flush action resets the store. -- -- Note that this function /will/ buffer any input sent to it on the heap. -- Please don't use this unless you're sure that the amount of input provided -- is bounded and will fit in memory without issues. -- -- @ -- ghci> (os, flush) <- Streams.'vectorOutputStream' :: IO ('OutputStream' Int, IO (V.'Vector' Int)) -- ghci> Streams.'System.IO.Streams.write' (Just 1) os -- ghci> Streams.'System.IO.Streams.write' (Just 2) os -- ghci> flush -- fromList [1,2] -- ghci> Streams.'System.IO.Streams.write' (Just 3) os -- ghci> Streams.'System.IO.Streams.write' Nothing os -- ghci> Streams.'System.IO.Streams.write' (Just 4) os -- ghci> flush -- fromList [3] -- @ vectorOutputStream :: Vector v c => IO (OutputStream c, IO (v c)) vectorOutputStream = vectorOutputStreamSized dEFAULT_BUFSIZ {-# INLINE vectorOutputStream #-} ------------------------------------------------------------------------------ -- | Like 'vectorOutputStream', but allows control over how large the vector -- buffer is to start with. vectorOutputStreamSized :: Vector v c => Int -> IO (OutputStream c, IO (v c)) vectorOutputStreamSized n = do (os, flush) <- mutableVectorOutputStreamSized n return $! (os, flush >>= V.basicUnsafeFreeze) ------------------------------------------------------------------------------ data VectorFillInfo v c = VectorFillInfo { _vec :: !(v (PrimState IO) c) , _idx :: {-# UNPACK #-} !(IORef Int) -- TODO: vector contains its own size , _sz :: {-# UNPACK #-} !(IORef Int) } ------------------------------------------------------------------------------ vfNew :: MVector v a => Int -> IO (VectorFillInfo v a) vfNew initialSize = do v <- VM.unsafeNew initialSize i <- newIORef 0 sz <- newIORef initialSize return $! VectorFillInfo v i sz ------------------------------------------------------------------------------ vfFinish :: MVector v a => VectorFillInfo v a -> IO (v (PrimState IO) a) vfFinish vfi = liftM (flip VM.unsafeTake v) $ readIORef i where v = _vec vfi i = _idx vfi ------------------------------------------------------------------------------ vfAppend :: MVector v a => VectorFillInfo v a -> a -> IO (VectorFillInfo v a) vfAppend vfi !x = do i <- readIORef iRef sz <- readIORef szRef if i < sz then add i else grow sz where v = _vec vfi iRef = _idx vfi szRef = _sz vfi add i = do VM.unsafeWrite v i x writeIORef iRef $! i + 1 return vfi grow sz = do let !sz' = sz * 2 v' <- VM.unsafeGrow v sz writeIORef szRef sz' vfAppend (vfi { _vec = v' }) x ------------------------------------------------------------------------------ -- | 'mutableVectorOutputStream' returns an 'OutputStream' which stores values -- fed into it and an action which flushes all stored values to a vector. -- -- The flush action resets the store. -- -- Note that this function /will/ buffer any input sent to it on the heap. -- Please don't use this unless you're sure that the amount of input provided -- is bounded and will fit in memory without issues. mutableVectorOutputStream :: VM.MVector v c => IO (OutputStream c, IO (v (PrimState IO) c)) mutableVectorOutputStream = mutableVectorOutputStreamSized dEFAULT_BUFSIZ ------------------------------------------------------------------------------ -- | Like 'mutableVectorOutputStream', but allows control over how large the -- vector buffer is to start with. mutableVectorOutputStreamSized :: VM.MVector v c => Int -> IO (OutputStream c, IO (v (PrimState IO) c)) mutableVectorOutputStreamSized initialSize = do r <- vfNew initialSize >>= newMVar c <- S.fromConsumer $ consumer r return (c, flush r) where consumer r = go where go = S.await >>= (maybe (return $! ()) $ \c -> do liftIO $ modifyMVar_ r $ flip vfAppend c go) flush r = modifyMVar r $ \vfi -> do !v <- vfFinish vfi vfi' <- vfNew initialSize return $! (vfi', v) {-# INLINE mutableVectorOutputStreamSized #-} ------------------------------------------------------------------------------ -- | Given an IO action that requires an 'OutputStream', creates one and -- captures all the output the action sends to it as a mutable vector. -- -- Example: -- -- @ -- ghci> import "Control.Applicative" -- ghci> ('connect' \<\$\> 'System.IO.Streams.fromList' [1, 2, 3::'Int']) -- \>\>= 'outputToMutableVector' -- \>\>= V.'Data.Vector.freeze' -- fromList [1,2,3] -- @ outputToMutableVector :: MVector v a => (OutputStream a -> IO b) -> IO (v (PrimState IO) a) outputToMutableVector = outputToMutableVectorSized dEFAULT_BUFSIZ {-# INLINE outputToMutableVector #-} ------------------------------------------------------------------------------ -- | Like 'outputToMutableVector', but allows control over how large the vector -- buffer is to start with. outputToMutableVectorSized :: MVector v a => Int -> (OutputStream a -> IO b) -> IO (v (PrimState IO) a) outputToMutableVectorSized n f = do (os, getVec) <- mutableVectorOutputStreamSized n _ <- f os getVec {-# INLINE outputToMutableVectorSized #-} ------------------------------------------------------------------------------ -- | Given an IO action that requires an 'OutputStream', creates one and -- captures all the output the action sends to it as a vector. -- -- Example: -- -- @ -- ghci> (('connect' <$> 'System.IO.Streams.fromList' [1, 2, 3]) >>= 'outputToVector') -- :: IO ('Data.Vector.Vector' Int) -- fromList [1,2,3] -- @ outputToVector :: Vector v a => (OutputStream a -> IO b) -> IO (v a) outputToVector = outputToVectorSized dEFAULT_BUFSIZ {-# INLINE outputToVector #-} ------------------------------------------------------------------------------ -- | Like 'outputToVector', but allows control over how large the vector buffer -- is to start with. outputToVectorSized :: Vector v a => Int -> (OutputStream a -> IO b) -> IO (v a) outputToVectorSized n = outputToMutableVectorSized n >=> V.basicUnsafeFreeze {-# INLINE outputToVectorSized #-} ------------------------------------------------------------------------------ -- | Splits an input stream into chunks of at most size @n@. -- -- Example: -- -- @ -- ghci> ('System.IO.Streams.fromList' [1..14::Int] >>= 'chunkVector' 4 >>= 'System.IO.Streams.toList') -- :: IO ['Data.Vector.Vector' Int] -- [fromList [1,2,3,4],fromList [5,6,7,8],fromList [9,10,11,12],fromList [13,14]] -- @ chunkVector :: Vector v a => Int -> InputStream a -> IO (InputStream (v a)) chunkVector n input = if n <= 0 then error $ "chunkVector: bad size: " ++ show n else vfNew n >>= fromGenerator . go n where doneChunk !vfi = do liftIO (vfFinish vfi >>= V.unsafeFreeze) >>= yield !vfi' <- liftIO $ vfNew n go n vfi' go !k !vfi | k <= 0 = doneChunk vfi | otherwise = liftIO (S.read input) >>= maybe finish chunk where finish = do v <- liftIO (vfFinish vfi >>= V.unsafeFreeze) if V.null v then return $! () else yield v chunk x = do !vfi' <- liftIO $ vfAppend vfi x go (k - 1) vfi' {-# INLINE chunkVector #-} ------------------------------------------------------------------------------ -- | Feeds a vector to an 'OutputStream'. Does /not/ write an end-of-stream to -- the stream. -- -- @ -- ghci> let v = V.'fromList' [1..4] :: V.'Vector' Int -- ghci> os \<- Streams.'unlines' Streams.'stdout' >>= Streams.'System.IO.Streams.contramap' (S.pack . show) :: IO ('OutputStream' Int) -- ghci> Streams.'writeVector' v os -- 1 -- 2 -- 3 -- 4 -- @ writeVector :: Vector v a => v a -> OutputStream a -> IO () writeVector v out = V.mapM_ (flip S.write out . Just) v {-# INLINE writeVector #-} ------------------------------------------------------------------------------ dEFAULT_BUFSIZ :: Int dEFAULT_BUFSIZ = 64 io-streams-1.1.2.2/src/System/IO/Streams/Internal.hs0000644000000000000000000005354312251607076020254 0ustar0000000000000000-- | Internal implementation of the @io-streams@ library, intended for library -- writers -- -- Library users should use the interface provided by "System.IO.Streams" {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeSynonymInstances #-} module System.IO.Streams.Internal ( -- * Types SP(..) , StreamPair -- * About pushback -- $pushback -- * Input and output streams , InputStream(..) , OutputStream(..) -- * Primitive stream operations , read , unRead , peek , write , atEOF -- * Building streams , makeInputStream , makeOutputStream , appendInputStream , concatInputStreams -- * Connecting streams , connect , connectTo , supply , supplyTo -- * Thread safety , lockingInputStream , lockingOutputStream -- * Utility streams , nullInput , nullOutput -- * Generator monad , Generator , fromGenerator , yield -- * Consumer monad , Consumer , fromConsumer , await ) where ------------------------------------------------------------------------------ import Control.Applicative (Applicative (..)) import Control.Concurrent (newMVar, withMVar) import Control.Exception (throwIO) import Control.Monad (when) import Control.Monad.IO.Class (MonadIO (..)) import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as S import qualified Data.ByteString.Internal as S import qualified Data.ByteString.Unsafe as S import Data.IORef (newIORef, readIORef, writeIORef) import Data.Maybe (isNothing) import Data.Typeable (Typeable) import Data.Word (Word8) import Foreign.Marshal.Utils (copyBytes) import Foreign.Ptr (castPtr) import qualified GHC.IO.Buffer as H import qualified GHC.IO.BufferedIO as H import qualified GHC.IO.Device as H import GHC.IO.Exception (unsupportedOperation) import Prelude hiding (read) ------------------------------------------------------------------------------ -- | A strict pair type. data SP a b = SP !a !b deriving (Typeable) ------------------------------------------------------------------------------ -- | An 'InputStream' generates values of type @c@ in the 'IO' monad. -- -- Two primitive operations are defined on 'InputStream': -- -- * @'read' :: 'InputStream' c -> 'IO' ('Maybe' c)@ reads a value from the stream, -- where \"end of stream\" is signaled by 'read' returning 'Nothing'. -- -- * @'unRead' :: c -> 'InputStream' c -> 'IO' ()@ \"pushes back\" a value to the -- stream. -- -- It is intended that 'InputStream's obey the following law: -- -- @'unRead' c stream >> 'read' stream === 'return' ('Just' c)@ -- data InputStream a = InputStream { _read :: IO (Maybe a) , _unRead :: a -> IO () } deriving (Typeable) ------------------------------------------------------------------------------ -- | An 'OutputStream' consumes values of type @c@ in the 'IO' monad. -- The only primitive operation defined on 'OutputStream' is: -- -- * @'write' :: 'Maybe' c -> 'OutputStream' c -> 'IO' ()@ -- -- Values of type @c@ are written in an 'OutputStream' by wrapping them in -- 'Just', and the end of the stream is indicated by by supplying 'Nothing'. -- -- If you supply a value after a 'Nothing', the behavior is defined by the -- implementer of the given 'OutputStream'. (All 'OutputStream' definitions in -- this library will simply discard the extra input.) -- data OutputStream a = OutputStream { _write :: Maybe a -> IO () } deriving (Typeable) ------------------------------------------------------------------------------ -- | Reads one value from an 'InputStream'. -- -- Returns either a value wrapped in a 'Just', or 'Nothing' if the end of the -- stream is reached. read :: InputStream a -> IO (Maybe a) read = _read {-# INLINE read #-} ------------------------------------------------------------------------------ -- | Feeds a value to an 'OutputStream'. Values of type @c@ are written in an -- 'OutputStream' by wrapping them in 'Just', and the end of the stream is -- indicated by by supplying 'Nothing'. -- write :: Maybe a -> OutputStream a -> IO () write = flip _write {-# INLINE write #-} ------------------------------------------------------------------------------ -- | Observes the first value from an 'InputStream' without consuming it. -- -- Returns 'Nothing' if the 'InputStream' is empty. 'peek' satisfies the -- following law: -- -- @ -- Streams.'peek' stream >> Streams.'read' stream === Streams.'read' stream -- @ peek :: InputStream a -> IO (Maybe a) peek s = do x <- read s maybe (return $! ()) (_unRead s) x return x ------------------------------------------------------------------------------ -- | Pushes a value back onto an input stream. 'read' and 'unRead' should -- satisfy the following law, with the possible exception of side effects: -- -- @ -- Streams.'unRead' c stream >> Streams.'read' stream === 'return' ('Just' c) -- @ -- -- Note that this could be used to add values back to the stream that were not -- originally drawn from the stream. unRead :: a -> InputStream a -> IO () unRead = flip _unRead ------------------------------------------------------------------------------ -- | Connects an 'InputStream' and 'OutputStream', supplying values from the -- 'InputStream' to the 'OutputStream', and propagating the end-of-stream -- message from the 'InputStream' through to the 'OutputStream'. -- -- The connection ends when the 'InputStream' yields a 'Nothing'. connect :: InputStream a -> OutputStream a -> IO () connect p q = loop where loop = do m <- read p maybe (write Nothing q) (const $ write m q >> loop) m {-# INLINE connect #-} ------------------------------------------------------------------------------ -- | The 'connectTo' function is just @'flip' 'connect'@. -- -- Useful for writing expressions like @fromList [1,2,3] >>= connectTo foo@. -- connectTo :: OutputStream a -> InputStream a -> IO () connectTo = flip connect {-# INLINE connectTo #-} ------------------------------------------------------------------------------ -- | Connects an 'InputStream' to an 'OutputStream' without passing the -- end-of-stream notification through to the 'OutputStream'. -- -- Use this to supply an 'OutputStream' with multiple 'InputStream's and use -- 'connect' for the final 'InputStream' to finalize the 'OutputStream', like -- so: -- -- @ -- do Streams.'supply' input1 output -- Streams.'supply' input2 output -- Streams.'connect' input3 output -- @ -- supply :: InputStream a -> OutputStream a -> IO () supply p q = loop where loop = do m <- read p maybe (return $! ()) (const $ write m q >> loop) m {-# INLINE supply #-} ------------------------------------------------------------------------------ -- | 'supply' with the arguments flipped. supplyTo :: OutputStream a -> InputStream a -> IO () supplyTo = flip supply {-# INLINE supplyTo #-} ------------------------------------------------------------------------------ -- | Creates an 'InputStream' from a value-producing action. -- -- (@makeInputStream m@) calls the action @m@ each time you request a value -- from the 'InputStream'. The given action is extended with the default -- pushback mechanism (see "System.IO.Streams.Internal#pushback"). makeInputStream :: IO (Maybe a) -> IO (InputStream a) makeInputStream m = do doneRef <- newIORef False pbRef <- newIORef [] return $! InputStream (grab doneRef pbRef) (pb pbRef) where grab doneRef pbRef = do l <- readIORef pbRef case l of [] -> do done <- readIORef doneRef if done then return Nothing else do x <- m when (isNothing x) $ writeIORef doneRef True return x (x:xs) -> writeIORef pbRef xs >> (return $! Just x) pb ref x = readIORef ref >>= \xs -> writeIORef ref (x:xs) {-# INLINE makeInputStream #-} ------------------------------------------------------------------------------ -- | Creates an 'OutputStream' from a value-consuming action. -- -- (@makeOutputStream f@) runs the computation @f@ on each value fed to it. makeOutputStream :: (Maybe a -> IO ()) -> IO (OutputStream a) makeOutputStream = return . OutputStream ------------------------------------------------------------------------------ -- | Converts an 'InputStream' into a thread-safe 'InputStream', at a slight -- performance penalty. -- -- For performance reasons, this library provides non-thread-safe streams by -- default. Use the @locking@ functions to convert these streams into slightly -- slower, but thread-safe, equivalents. lockingInputStream :: InputStream a -> IO (InputStream a) lockingInputStream s = do mv <- newMVar $! () return $! InputStream (grab mv) (pb mv) where grab mv = withMVar mv $ const $ read s pb mv x = withMVar mv $ const $ unRead x s {-# INLINE lockingInputStream #-} ------------------------------------------------------------------------------ -- | Converts an 'OutputStream' into a thread-safe 'OutputStream', at a slight -- performance penalty. -- -- For performance reasons, this library provides non-thread-safe streams by -- default. Use the @locking@ functions to convert these streams into slightly -- slower, but thread-safe, equivalents. lockingOutputStream :: OutputStream a -> IO (OutputStream a) lockingOutputStream s = do mv <- newMVar $! () makeOutputStream $ f mv where f mv x = withMVar mv $ const $ write x s {-# INLINE lockingOutputStream #-} ------------------------------------------------------------------------------ -- | An empty 'InputStream' that yields 'Nothing' immediately. nullInput :: IO (InputStream a) nullInput = makeInputStream $ return Nothing ------------------------------------------------------------------------------ -- | An empty 'OutputStream' that discards any input fed to it. nullOutput :: IO (OutputStream a) nullOutput = makeOutputStream $ const $ return $! () ------------------------------------------------------------------------------ -- | 'appendInputStream' concatenates two 'InputStream's, analogous to ('++') -- for lists. -- -- The second 'InputStream' continues where the first 'InputStream' ends. -- -- Note: values pushed back to 'appendInputStream' are not propagated to either -- wrapped 'InputStream'. appendInputStream :: InputStream a -> InputStream a -> IO (InputStream a) appendInputStream s1 s2 = concatInputStreams [s1, s2] ------------------------------------------------------------------------------ -- | 'concatInputStreams' concatenates a list of 'InputStream's, analogous to -- ('++') for lists. -- -- Subsequent 'InputStream's continue where the previous one 'InputStream' -- ends. -- -- Note: values pushed back to the 'InputStream' returned by -- 'concatInputStreams' are not propagated to any of the source -- 'InputStream's. concatInputStreams :: [InputStream a] -> IO (InputStream a) concatInputStreams inputStreams = do ref <- newIORef inputStreams makeInputStream $! run ref where run ref = go where go = do streams <- readIORef ref case streams of [] -> return Nothing (s:rest) -> do next <- read s case next of Nothing -> writeIORef ref rest >> go Just _ -> return next ------------------------------------------------------------------------------ -- | Checks if an 'InputStream' is at end-of-stream. atEOF :: InputStream a -> IO Bool atEOF s = read s >>= maybe (return True) (\k -> unRead k s >> return False) ------------------------------------------------------------------------------ -- $pushback -- #pushback# -- -- Users can push a value back into an input stream using the 'unRead' -- function. Usually this will use the default pushback mechanism which -- provides a buffer for the stream. Some stream transformers, like -- 'takeBytes', produce streams that send pushed-back values back to the -- streams that they wrap. A function like 'System.IO.Streams.Combinators.map' -- cannot do this because the types don't match up: -- -- @ -- 'System.IO.Streams.Combinators.map' :: (a -> b) -> 'InputStream' a -> 'IO' ('InputStream' b) -- @ -- -- A function will usually document if its pushback behaviour differs from the -- default. No matter what the case, input streams should obey the following -- law: -- -- @ -- Streams.'unRead' c stream >> Streams.'read' stream === 'return' ('Just' c) -- @ -------------------------------------------- -- Typeclass instances for Handle support -- -------------------------------------------- ------------------------------------------------------------------------------ bUFSIZ :: Int bUFSIZ = 32752 ------------------------------------------------------------------------------ unsupported :: IO a unsupported = throwIO unsupportedOperation ------------------------------------------------------------------------------ bufferToBS :: H.Buffer Word8 -> ByteString bufferToBS buf = S.copy $! S.fromForeignPtr raw l sz where raw = H.bufRaw buf l = H.bufL buf r = H.bufR buf sz = r - l ------------------------------------------------------------------------------ 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 let c = min n l copyBytes ptr (castPtr cstr) c return $! c readNonBlocking _ _ _ = unsupported write _ _ _ = unsupported writeNonBlocking _ _ _ = unsupported ------------------------------------------------------------------------------ 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 ------------------------------------------------------------------------------ -- | Internal convenience synonym for a pair of input\/output streams. type StreamPair a = SP (InputStream a) (OutputStream a) 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 ------------------------------------------------------------------------------ instance H.BufferedIO (OutputStream ByteString) where newBuffer !_ bs = H.newByteBuffer bUFSIZ bs fillReadBuffer !_ _ = unsupported fillReadBuffer0 !_ _ = unsupported flushWriteBuffer !os !buf = do write (Just $! bufferToBS buf) os emptyWriteBuffer buf flushWriteBuffer0 !os !buf = do let s = bufferToBS buf let l = S.length s write (Just s) os buf' <- emptyWriteBuffer buf return $! (l, buf') ------------------------------------------------------------------------------ instance H.BufferedIO (InputStream ByteString) where newBuffer !_ !bs = H.newByteBuffer bUFSIZ bs fillReadBuffer !is !buf = H.readBuf is buf fillReadBuffer0 _ _ = unsupported flushWriteBuffer _ _ = unsupported flushWriteBuffer0 _ _ = unsupported ------------------------------------------------------------------------------ instance H.BufferedIO (StreamPair ByteString) where newBuffer !_ bs = H.newByteBuffer bUFSIZ bs fillReadBuffer (SP is _) = H.fillReadBuffer is fillReadBuffer0 _ _ = unsupported flushWriteBuffer (SP _ !os) = H.flushWriteBuffer os flushWriteBuffer0 (SP _ !os) = H.flushWriteBuffer0 os ------------------------------------------------------------------------------ instance H.IODevice (OutputStream ByteString) where ready _ _ _ = return True close = write Nothing devType _ = return H.Stream ------------------------------------------------------------------------------ instance H.IODevice (InputStream ByteString) where ready _ _ _ = return True close _ = return $! () devType _ = return H.Stream ------------------------------------------------------------------------------ instance H.IODevice (StreamPair ByteString) where ready _ _ _ = return True close (SP _ os) = write Nothing os devType _ = return H.Stream ------------------------------------------------------------------------------ emptyWriteBuffer :: H.Buffer Word8 -> IO (H.Buffer Word8) emptyWriteBuffer buf = return buf { H.bufL=0, H.bufR=0, H.bufState = H.WriteBuffer } ------------------------------------------------------------------------------ -- | A 'Generator' is a coroutine monad that can be used to define complex -- 'InputStream's. You can cause a value of type @Just r@ to appear when the -- 'InputStream' is read by calling 'yield': -- -- @ -- g :: 'Generator' Int () -- g = do -- Streams.'yield' 1 -- Streams.'yield' 2 -- Streams.'yield' 3 -- @ -- -- A 'Generator' can be turned into an 'InputStream' by calling -- 'fromGenerator': -- -- @ -- m :: 'IO' ['Int'] -- m = Streams.'fromGenerator' g >>= Streams.'System.IO.Streams.toList' \-\- value returned is [1,2,3] -- @ -- -- You can perform IO by calling 'liftIO', and turn a 'Generator' into an -- 'InputStream' with 'fromGenerator'. -- -- As a general rule, you should not acquire resources that need to be freed -- from a 'Generator', because there is no guarantee the coroutine continuation -- will ever be called, nor can you catch an exception from within a -- 'Generator'. newtype Generator r a = Generator { unG :: IO (Either (SP r (Generator r a)) a) } deriving (Typeable) ------------------------------------------------------------------------------ generatorBind :: Generator r a -> (a -> Generator r b) -> Generator r b generatorBind (Generator m) f = Generator (m >>= either step value) where step (SP v r) = return $! Left $! SP v (generatorBind r f) value = unG . f {-# INLINE generatorBind #-} ------------------------------------------------------------------------------ instance Monad (Generator r) where return = Generator . return . Right (>>=) = generatorBind ------------------------------------------------------------------------------ instance MonadIO (Generator r) where liftIO = Generator . (Right `fmap`) ------------------------------------------------------------------------------ instance Functor (Generator r) where fmap f (Generator m) = Generator $ m >>= either step value where step (SP v m') = return $! Left $! SP v (fmap f m') value v = return $! Right $! f v ------------------------------------------------------------------------------ instance Applicative (Generator r) where pure = Generator . return . Right m <*> n = do f <- m v <- n return $! f v ------------------------------------------------------------------------------ -- | Calling @'yield' x@ causes the value @'Just' x@ to appear on the input -- when this generator is converted to an 'InputStream'. The rest of the -- computation after the call to 'yield' is resumed later when the -- 'InputStream' is 'read' again. yield :: r -> Generator r () yield x = Generator $! return $! Left $! SP x (return $! ()) ------------------------------------------------------------------------------ -- | Turns a 'Generator' into an 'InputStream'. fromGenerator :: Generator r a -> IO (InputStream r) fromGenerator (Generator m) = do ref <- newIORef m makeInputStream $! go ref where go ref = readIORef ref >>= (\n -> n >>= either step finish) where step (SP v gen) = do writeIORef ref $! unG gen return $! Just v finish _ = return Nothing ------------------------------------------------------------------------------ newtype Consumer c a = Consumer { unC :: IO (Either (Maybe c -> Consumer c a) a) } deriving (Typeable) ------------------------------------------------------------------------------ instance Monad (Consumer c) where return = Consumer . return . Right (Consumer m) >>= f = Consumer $ m >>= either step value where step g = return $! Left $! (>>= f) . g value v = unC $ f v ------------------------------------------------------------------------------ instance MonadIO (Consumer c) where liftIO = Consumer . fmap Right ------------------------------------------------------------------------------ instance Functor (Consumer r) where fmap f (Consumer m) = Consumer (m >>= either step value) where step g = return $! Left $! (fmap f) . g value v = return $! Right $! f v ------------------------------------------------------------------------------ instance Applicative (Consumer r) where pure = return m <*> n = do f <- m v <- n return $! f v ------------------------------------------------------------------------------ await :: Consumer r (Maybe r) await = Consumer $ return (Left return) ------------------------------------------------------------------------------ fromConsumer :: Consumer r a -> IO (OutputStream r) fromConsumer c0 = newIORef c0 >>= makeOutputStream . go where go ref mb = do c <- readIORef ref c' <- unC c >>= either step (const $! return c) writeIORef ref c' where force c = do e <- unC c return $! Consumer $! return e step g = force $! g mb io-streams-1.1.2.2/src/System/IO/Streams/Tutorial.hs0000644000000000000000000003772612251607076020310 0ustar0000000000000000module System.IO.Streams.Tutorial ( -- * Introduction -- $introduction -- * Build Input Streams -- $createinput -- * Build Output Streams -- $createoutput -- * Connect Streams -- $connect -- * Transform Streams -- $transform -- * Resource and Exception Safety -- $safety -- * Pushback -- $pushback -- * Thread Safety -- $threadsafety -- * Examples -- $examples ) where {- $introduction The @io-streams@ package defines two \"smart handles\" for stream processing: * 'System.IO.Streams.InputStream': a read-only smart handle * 'System.IO.Streams.OutputStream': a write-only smart handle The 'System.IO.Streams.InputStream' type implements all the core operations we expect for a read-only handle. We consume values using 'read', which returns a 'Nothing' when the resource is done: @ 'System.IO.Streams.read' :: 'System.IO.Streams.InputStream' c -> 'IO' ('Maybe' c) @ ... and we can push back values using 'System.IO.Streams.unRead': @ 'System.IO.Streams.unRead' :: c -> 'System.IO.Streams.InputStream' c -> 'IO' () @ The 'System.IO.Streams.OutputStream' type implements the 'System.IO.Streams.write' operation which feeds it output, supplying 'Nothing' to signal resource exhaustion: @ 'System.IO.Streams.write' :: 'Maybe' c -> 'System.IO.Streams.OutputStream' c -> 'IO' () @ These streams slightly resemble Haskell 'System.IO.Handle's, but support a wider range of sources and sinks. For example, you can convert an ordinary list to an 'System.IO.Streams.InputStream' source and interact with it using the handle-based API: @ ghci> import qualified System.IO.Streams as S ghci> listHandle \<- S.'System.IO.Streams.fromList' [1, 2] ghci> S.'System.IO.Streams.read' listHandle Just 1 ghci> S.'System.IO.Streams.read' listHandle Just 2 ghci> S.'System.IO.Streams.read' listHandle Nothing @ Additionally, IO streams come with a library of stream transformations that preserve their handle-like API. For example, you can map a function over an 'System.IO.Streams.InputStream', which generates a new handle to the same stream that returns transformed values: @ ghci> oldHandle \<- S.'System.IO.Streams.List.fromList' [1, 2, 3] ghci> newHandle \<- S.'System.IO.Streams.Combinators.mapM' (\\x -\> 'return' (x * 10)) oldHandle ghci> S.'System.IO.Streams.read' newHandle 10 ghci> -- We can still view the stream through the old handle ghci> S.'System.IO.Streams.read' oldHandle 2 ghci> -- ... and switch back again ghci> S.'System.IO.Streams.read' newHandle 30 @ IO streams focus on preserving the convention of traditional handles while offering a wider library of stream-processing utilities. -} {- $createinput The @io-streams@ library provides a simple interface for creating your own 'System.IO.Streams.InputStream's and 'System.IO.Streams.OutputStream's. You can build an 'System.IO.Streams.InputStream' from any 'IO' action that generates output, as long as it wraps results in 'Just' and uses 'Nothing' to signal EOF: @ 'System.IO.Streams.makeInputStream' :: 'IO' ('Maybe' a) -> 'IO' ('System.IO.Streams.InputStream' a) @ As an example, let's wrap an ordinary read-only 'System.IO.Handle' in an 'System.IO.Streams.InputStream': @ import "Data.ByteString" ('Data.ByteString.ByteString') import qualified "Data.ByteString" as S import "System.IO.Streams" ('System.IO.Streams.InputStream') import qualified "System.IO.Streams" as Streams import "System.IO" ('System.IO.Handle', 'System.IO.hFlush') bUFSIZ = 32752 upgradeReadOnlyHandle :: 'System.IO.Handle' -> 'IO' ('System.IO.Streams.InputStream' 'Data.ByteString.ByteString') upgradeReadOnlyHandle h = Streams.'System.IO.Streams.makeInputStream' f where f = do x <- S.'Data.ByteString.hGetSome' h bUFSIZ 'return' $! if S.'Data.ByteString.null' x then 'Nothing' else 'Just' x @ We didn't even really need to write the @upgradeReadOnlyHandle@ function, because "System.IO.Streams.Handle" already provides one that uses the exact same implementation given above: @ 'System.IO.Streams.handleToInputStream' :: 'System.IO.Handle' -> 'IO' ('System.IO.Streams.InputStream' 'Data.ByteString.ByteString') @ -} {- $createoutput Similarly, you can build any 'System.IO.Streams.OutputStream' from an 'IO' action that accepts input, as long as it interprets 'Just' as more input and 'Nothing' as EOF: @ 'System.IO.Streams.makeOutputStream' :: ('Maybe' a -> 'IO' ()) -> 'IO' ('System.IO.Streams.OutputStream' a) @ A simple 'System.IO.Streams.OutputStream' might wrap 'putStrLn' for 'Data.ByteString.ByteString's: @ import "Data.ByteString" ('Data.ByteString.ByteString') import qualified "Data.ByteString" as S import "System.IO.Streams" ('System.IO.Streams.OutputStream') import qualified "System.IO.Streams" as Streams \ writeConsole :: 'IO' ('System.IO.Streams.OutputStream' 'Data.ByteString.ByteString') writeConsole = Streams.'System.IO.Streams.makeOutputStream' $ \\m -> case m of 'Just' bs -> S.'Data.ByteString.putStrLn' bs 'Nothing' -> 'return' () @ The 'Just' wraps more incoming data, whereas 'Nothing' indicates the data is exhausted. In principle, you can feed 'System.IO.Streams.OutputStream's more input after writing a 'Nothing' to them, but IO streams only guarantee a well-defined behavior up to the first 'Nothing'. After receiving the first 'Nothing', an 'System.IO.Streams.OutputStream' could respond to additional input by: * Using the input * Ignoring the input * Throwing an exception Ideally, you should adhere to well-defined behavior and ensure that after you write a 'Nothing' to an 'System.IO.Streams.OutputStream', you don't write anything else. -} {- $connect @io-streams@ provides two ways to connect an 'System.IO.Streams.InputStream' and 'System.IO.Streams.OutputStream': @ 'System.IO.Streams.connect' :: 'System.IO.Streams.InputStream' a -> 'System.IO.Streams.OutputStream' a -> 'IO' () 'System.IO.Streams.supply' :: 'System.IO.Streams.InputStream' a -> 'System.IO.Streams.OutputStream' a -> 'IO' () @ 'System.IO.Streams.connect' feeds the 'System.IO.Streams.OutputStream' exclusively with the given 'System.IO.Streams.InputStream' and passes along the end-of-stream notification to the 'System.IO.Streams.OutputStream'. 'System.IO.Streams.supply' feeds the 'System.IO.Streams.OutputStream' non-exclusively with the given 'System.IO.Streams.InputStream' and does not pass along the end-of-stream notification to the 'System.IO.Streams.OutputStream'. You can combine both 'System.IO.Streams.supply' and 'System.IO.Streams.connect' to feed multiple 'System.IO.Streams.InputStream's into a single 'System.IO.Streams.OutputStream': @ import qualified "System.IO.Streams" as Streams import "System.IO" ('System.IO.IOMode'('System.IO.WriteMode')) main = do Streams.'System.IO.Streams.withFileAsOutput' \"out.txt\" 'System.IO.WriteMode' $ \\outStream -> Streams.'System.IO.Streams.withFileAsInput' \"in1.txt\" $ \\inStream1 -> Streams.'System.IO.Streams.withFileAsInput' \"in2.txt\" $ \\inStream2 -> Streams.'System.IO.Streams.withFileAsInput' \"in3.txt\" $ \\inStream3 -> Streams.'System.IO.Streams.supply' inStream1 outStream Streams.'System.IO.Streams.supply' inStream2 outStream Streams.'System.IO.Streams.connect' inStream3 outStream @ The final 'System.IO.Streams.connect' seals the 'System.IO.Streams.OutputStream' when the final 'System.IO.Streams.InputStream' terminates. Keep in mind that you do not need to use 'System.IO.Streams.connect' or 'System.IO.Streams.supply' at all: @io-streams@ mainly provides them for user convenience. You can always build your own abstractions on top of the 'System.IO.Streams.read' and 'System.IO.Streams.write' operations. -} {- $transform When we build or use 'IO' streams we can tap into all the stream-processing features the @io-streams@ library provides. For example, we can decompress any 'System.IO.Streams.InputStream' of 'Data.ByteString.ByteString's: @ import "Control.Monad" ((>=>)) import "Data.ByteString" ('Data.ByteString.ByteString') import "System.IO" ('System.IO.Handle') import "System.IO.Streams" ('System.IO.Streams.InputStream', 'System.IO.Streams.OutputStream') import qualified "System.IO.Streams" as Streams import qualified "System.IO.Streams.File" as Streams unzipHandle :: 'System.IO.Handle' -> 'IO' ('System.IO.Streams.InputStream' 'Data.ByteString.ByteString') unzipHandle = Streams.'System.IO.Streams.handleToInputStream' >=> Streams.'System.IO.Streams.decompress' @ ... or we can guard it against a denial-of-service attack: @ protectHandle :: 'System.IO.Handle' -> 'IO' ('System.IO.Streams.InputStream' 'Data.ByteString.ByteString') protectHandle = Streams.'System.IO.Streams.handleToInputStream' >=> Streams.'System.IO.Streams.throwIfProducesMoreThan' 1000000 @ @io-streams@ provides many useful functions such as these in its standard library and you take advantage of them by defining IO streams that wrap your resources. -} {- $safety IO streams use standard Haskell idioms for resource safety. Since all operations occur in the IO monad, you can use 'Control.Exception.catch', 'Control.Exception.bracket', or various \"@with...@\" functions to guard any 'System.IO.Streams.read' or 'System.IO.Streams.write' without any special considerations: @ import qualified "Data.ByteString" as S import "System.IO" import "System.IO.Streams" ('System.IO.Streams.InputStream', 'System.IO.Streams.OutputStream') import qualified "System.IO.Streams" as Streams import qualified "System.IO.Streams.File" as Streams main = 'System.IO.withFile' \"test.txt\" 'System.IO.ReadMode' $ \\handle -> do stream <- Streams.'System.IO.Streams.handleToInputStream' handle mBytes <- Streams.'System.IO.Streams.read' stream case mBytes of 'Just' bytes -> S.'Data.ByteString.putStrLn' bytes 'Nothing' -> 'System.IO.putStrLn' \"EOF\" @ However, you can also simplify the above example by using the convenience function 'System.IO.Streams.File.withFileAsInput' from "System.IO.Streams.File": @ 'System.IO.Streams.withFileAsInput' :: 'System.IO.FilePath' -> ('System.IO.Streams.InputStream' 'Data.ByteString.ByteString' -> 'IO' a) -> 'IO' a @ -} {- $pushback All 'System.IO.Streams.InputStream's support pushback, which simplifies many types of operations. For example, we can 'System.IO.Streams.peek' at an 'System.IO.Streams.InputStream' by combining 'System.IO.Streams.read' and 'System.IO.Streams.unRead': @ 'System.IO.Streams.peek' :: 'System.IO.Streams.InputStream' c -> 'IO' ('Maybe' c) 'System.IO.Streams.peek' s = do x <- Streams.'System.IO.Streams.read' s case x of 'Nothing' -> 'return' () 'Just' c -> Streams.'System.IO.Streams.unRead' c s 'return' x @ ... although "System.IO.Streams" already exports the above function. 'System.IO.Streams.InputStream's can customize pushback behavior to support more sophisticated support for pushback. For example, if you protect a stream using 'System.IO.Streams.throwIfProducesMoreThan' and 'System.IO.Streams.unRead' input, it will subtract the unread input from the total byte count. However, these extra features will not interfere with the basic pushback contract, given by the following law: @ 'System.IO.Streams.unRead' c stream >> 'System.IO.Streams.read' stream == 'return' ('Just' c) @ When you build an 'System.IO.Streams.InputStream' using 'System.IO.Streams.makeInputStream', it supplies the default pushback behavior which just saves the input for the next 'System.IO.Streams.read' call. More advanced users can use "System.IO.Streams.Internal" to customize their own pushback routines. {- NOTE: The library only exports pushback API for Sources, which are a completely internal type, so should we teach the user how to define custom pushback or not? Maybe that belongs in some sort of separate "advanced" tutorial for System.IO.Streams.Internal. -} -} {- $threadsafety IO stream operations are not thread-safe by default for performance reasons. However, you can transform an existing IO stream into a thread-safe one using the provided locking functions: @ 'System.IO.Streams.lockingInputStream' :: 'System.IO.Streams.InputStream' a -> 'IO' ('System.IO.Streams.InputStream' a) 'System.IO.Streams.lockingOutputStream' :: 'System.IO.Streams.OutputStream' a -> 'IO' ('System.IO.Streams.OutputStream' a) @ These functions do not prevent access to the previous IO stream, so you must take care to not save the reference to the previous stream. {- NOTE: Should I give specific performance numbers or just say something like "a slight cost to performance" for locking? -} {- NOTE: This could use a concrete example of a race condition that a user might encounter without this protection. -} -} -- $examples -- The following examples show how to use the standard library to implement -- traditional command-line utilities: -- -- @ --{-\# LANGUAGE OverloadedStrings #-} -- --import Control.Monad ((>=>), join) --import qualified Data.ByteString.Char8 as S --import Data.Int (Int64) --import Data.Monoid ((\<>)) --import "System.IO.Streams" ('System.IO.Streams.InputStream') --import qualified "System.IO.Streams" as Streams --import System.IO --import Prelude hiding (head) -- --cat :: 'FilePath' -> IO () --cat file = 'System.IO.withFile' file ReadMode $ \\h -> do -- is <- Streams.'System.IO.Streams.handleToInputStream' h -- Streams.'System.IO.Streams.connect' is Streams.'System.IO.Streams.stdout' -- --grep :: S.'Data.ByteString.ByteString' -> 'FilePath' -> IO () --grep pattern file = 'System.IO.withFile' file ReadMode $ \\h -> do -- is \<- Streams.'System.IO.Streams.handleToInputStream' h >>= -- Streams.'System.IO.Streams.lines' >>= -- Streams.'System.IO.Streams.filter' (S.isInfixOf pattern) -- os <- Streams.'System.IO.Streams.unlines' Streams.'System.IO.Streams.stdout' -- Streams.'System.IO.Streams.connect' is os -- --data Option = Bytes | Words | Lines -- --len :: 'System.IO.Streams.InputStream' a -> IO Int64 --len = Streams.'System.IO.Streams.fold' (\\n _ -> n + 1) 0 -- --wc :: Option -> 'FilePath' -> IO () --wc opt file = 'System.IO.withFile' file ReadMode $ -- Streams.'System.IO.Streams.handleToInputStream' >=> count >=> print -- where -- count = case opt of -- Bytes -> \\is -> do -- (is', cnt) <- Streams.'System.IO.Streams.countInput' is -- Streams.'System.IO.Streams.skipToEof' is' -- cnt -- Words -> Streams.'System.IO.Streams.words' >=> len -- Lines -> Streams.'System.IO.STreams.lines' >=> len -- --nl :: 'FilePath' -> IO () --nl file = 'System.IO.withFile' file ReadMode $ \\h -> do -- nats <- Streams.'System.IO.Streams.fromList' [1..] -- ls \<- Streams.'System.IO.Streams.handleToInputStream' h >>= Streams.'System.IO.Streams.lines' -- is <- Streams.'System.IO.Streams.zipWith' -- (\\n bs -> S.pack (show n) \<> \" \" \<> bs) -- nats -- ls -- os <- Streams.'System.IO.Streams.unlines' Streams.'System.IO.Streams.stdout' -- Streams.'System.IO.Streams.connect' is os -- --head :: Int64 -> 'FilePath' -> IO () --head n file = 'System.IO.withFile' file ReadMode $ \\h -> do -- is \<- Streams.'System.IO.Streams.handleToInputStream' h >>= Streams.'System.IO.Streams.lines' >>= Streams.'System.IO.Streams.take' n -- os <- Streams.'System.IO.Streams.unlines' Streams.'System.IO.Streams.stdout' -- Streams.'System.IO.Streams.connect' is os -- --paste :: 'FilePath' -> 'FilePath' -> IO () --paste file1 file2 = -- 'System.IO.withFile' file1 ReadMode $ \\h1 -> -- 'System.IO.withFile' file2 ReadMode $ \\h2 -> do -- is1 \<- Streams.'System.IO.Streams.handleToInputStream' h1 >>= Streams.'System.IO.Streams.lines' -- is2 \<- Streams.'System.IO.Streams.handleToInputStream' h2 >>= Streams.'System.IO.Streams.lines' -- isT \<- Streams.'System.IO.Streams.zipWith' (\\l1 l2 -> l1 \<> \"\\t\" \<> l2) is1 is2 -- os <- Streams.'System.IO.Streams.unlines' Streams.'System.IO.Streams.stdout' -- Streams.connect isT os -- --yes :: IO () --yes = do -- is <- Streams.fromList (repeat \"y\") -- os <- Streams.unlines Streams.stdout -- Streams.connect is os -- @ io-streams-1.1.2.2/src/System/IO/Streams/Attoparsec.hs0000644000000000000000000000042112251607076020570 0ustar0000000000000000-- | This module provides support for parsing values from 'InputStream's using -- @attoparsec@. module System.IO.Streams.Attoparsec ( -- * Parsing parseFromStream , parserToInputStream , ParseException(..) ) where import System.IO.Streams.Internal.Attoparsec io-streams-1.1.2.2/src/System/IO/Streams/Zlib.hs0000644000000000000000000002061212251607076017367 0ustar0000000000000000-- | Interface to @zlib@ and @gzip@ compression for 'Bytestring's and 'Builder's {-# LANGUAGE GeneralizedNewtypeDeriving #-} module System.IO.Streams.Zlib ( -- * ByteString decompression gunzip , decompress -- * ByteString compression , gzip , compress -- * Builder compression , gzipBuilder , compressBuilder -- * Compression level , CompressionLevel(..) , defaultCompressionLevel ) where ------------------------------------------------------------------------------ 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 Data.ByteString (ByteString) import qualified Data.ByteString as S import Data.IORef (newIORef, readIORef, writeIORef) import Prelude hiding (read) ------------------------------------------------------------------------------ import System.IO.Streams.Builder (unsafeBuilderStream) import System.IO.Streams.Internal (InputStream, OutputStream, makeInputStream, makeOutputStream, read, write) ------------------------------------------------------------------------------ gzipBits :: WindowBits gzipBits = WindowBits 31 ------------------------------------------------------------------------------ compressBits :: WindowBits compressBits = WindowBits 15 ------------------------------------------------------------------------------ -- | Decompress an 'InputStream' of strict 'ByteString's from the @gzip@ format gunzip :: InputStream ByteString -> IO (InputStream ByteString) gunzip input = initInflate gzipBits >>= inflate input ------------------------------------------------------------------------------ -- | Decompress an 'InputStream' of strict 'ByteString's from the @zlib@ format decompress :: InputStream ByteString -> IO (InputStream ByteString) decompress input = initInflate compressBits >>= inflate input ------------------------------------------------------------------------------ -- Note: bytes pushed back to this input stream are not propagated back to the -- source InputStream. data IS = Input | Popper Popper | Done inflate :: InputStream ByteString -> Inflate -> IO (InputStream ByteString) inflate input state = do ref <- newIORef Input makeInputStream $ stream ref where stream ref = go where go = readIORef ref >>= \st -> case st of Input -> read input >>= maybe eof chunk Popper p -> pop p Done -> return Nothing eof = do x <- finishInflate state writeIORef ref Done if (not $ S.null x) then return $! Just x else return Nothing chunk s = if S.null s then do out <- flushInflate state return $! Just out else feedInflate state s >>= \popper -> do writeIORef ref $ Popper popper pop popper pop popper = popper >>= maybe backToInput (return . Just) backToInput = writeIORef ref Input >> read input >>= maybe eof chunk ------------------------------------------------------------------------------ deflateBuilder :: OutputStream Builder -> Deflate -> IO (OutputStream Builder) deflateBuilder stream state = do zippedStr <- makeOutputStream bytestringStream >>= \x -> deflate x state -- we can use unsafeBuilderStream here because zlib is going to consume the -- stream unsafeBuilderStream (allocBuffer defaultBufferSize) zippedStr where bytestringStream x = write (fmap cvt x) stream cvt s | S.null s = flush | otherwise = fromByteString s ------------------------------------------------------------------------------ -- | Convert an 'OutputStream' that consumes compressed 'Builder's into an -- 'OutputStream' that consumes uncompressed 'Builder's in the @gzip@ format gzipBuilder :: CompressionLevel -> OutputStream Builder -> IO (OutputStream Builder) gzipBuilder level output = initDeflate (clamp level) gzipBits >>= deflateBuilder output ------------------------------------------------------------------------------ -- | Convert an 'OutputStream' that consumes compressed 'Builder's into an -- 'OutputStream' that consumes uncompressed 'Builder's in the @zlib@ format compressBuilder :: CompressionLevel -> OutputStream Builder -> IO (OutputStream Builder) compressBuilder level output = initDeflate (clamp level) compressBits >>= deflateBuilder output ------------------------------------------------------------------------------ deflate :: OutputStream ByteString -> Deflate -> IO (OutputStream ByteString) deflate output state = makeOutputStream stream where stream Nothing = popAll (finishDeflate state) >> write Nothing output stream (Just s) = do -- Empty string means flush if S.null s then do popAll (flushDeflate state) write (Just S.empty) output else feedDeflate state s >>= popAll popAll popper = go where go = popper >>= maybe (return $! ()) (\s -> write (Just s) output >> go) ------------------------------------------------------------------------------ -- | Parameter that defines the tradeoff between speed and compression ratio newtype CompressionLevel = CompressionLevel Int deriving (Read, Eq, Show, Num) ------------------------------------------------------------------------------ -- | A compression level that balances speed with compression ratio defaultCompressionLevel :: CompressionLevel defaultCompressionLevel = CompressionLevel 5 ------------------------------------------------------------------------------ clamp :: CompressionLevel -> Int clamp (CompressionLevel x) = min 9 (max x 0) ------------------------------------------------------------------------------ -- | Convert an 'OutputStream' that consumes compressed 'ByteString's into an -- 'OutputStream' that consumes uncompressed 'ByteString's in the @gzip@ format gzip :: CompressionLevel -> OutputStream ByteString -> IO (OutputStream ByteString) gzip level output = initDeflate (clamp level) gzipBits >>= deflate output ------------------------------------------------------------------------------ -- | Convert an 'OutputStream' that consumes compressed 'ByteString's into an -- 'OutputStream' that consumes uncompressed 'ByteString's in the @zlib@ format compress :: CompressionLevel -> OutputStream ByteString -> IO (OutputStream ByteString) compress level output = initDeflate (clamp level) compressBits >>= deflate output io-streams-1.1.2.2/src/System/IO/Streams/Core.hs0000644000000000000000000000137312251607076017362 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} -- | Core types and functions for the @io-streams@ library. -- module System.IO.Streams.Core ( -- * Stream types InputStream , OutputStream -- * Creating streams , makeInputStream , makeOutputStream -- * Primitive stream operations , read , unRead , peek , write , atEOF -- * Connecting streams together , connect , connectTo , supply , supplyTo -- * Thread safety \/ concurrency , lockingInputStream , lockingOutputStream -- * Utility streams , nullInput , nullOutput -- * Generator monad , Generator , fromGenerator , yield ) where import Prelude () import System.IO.Streams.Internal io-streams-1.1.2.2/src/System/IO/Streams/File.hs0000644000000000000000000001041312251607076017344 0ustar0000000000000000-- | Input and output streams for files. -- -- The functions in this file use \"with*\" or \"bracket\" semantics, i.e. they -- open the supplied 'FilePath', run a user computation, and then close the -- file handle. If you need more control over the lifecycle of the underlying -- file descriptor resources, you are encouraged to use the functions from -- "System.IO.Streams.Handle" instead. module System.IO.Streams.File ( -- * File conversions withFileAsInput , withFileAsInputStartingAt , unsafeWithFileAsInputStartingAt , withFileAsOutput , withFileAsOutputExt ) where ------------------------------------------------------------------------------ import Control.Monad (unless) import Data.ByteString (ByteString) import Data.Int (Int64) import System.IO (BufferMode (NoBuffering), IOMode (ReadMode, WriteMode), SeekMode (AbsoluteSeek), hSeek, hSetBuffering, withBinaryFile) ------------------------------------------------------------------------------ import System.IO.Streams.Handle import System.IO.Streams.Internal (InputStream, OutputStream) ------------------------------------------------------------------------------ -- | @'withFileAsInput' name act@ opens the specified file in \"read mode\" and -- passes the resulting 'InputStream' to the computation @act@. The file will -- be closed on exit from @withFileAsInput@, whether by normal termination or -- by raising an exception. -- -- If closing the file raises an exception, then /that/ exception will be -- raised by 'withFileAsInput' rather than any exception raised by @act@. withFileAsInput :: FilePath -- ^ file to open -> (InputStream ByteString -> IO a) -- ^ function to run -> IO a withFileAsInput = withFileAsInputStartingAt 0 ------------------------------------------------------------------------------ -- | Like 'withFileAsInput', but seeks to the specified byte offset before -- attaching the given file descriptor to the 'InputStream'. withFileAsInputStartingAt :: Int64 -- ^ starting index to seek to -> FilePath -- ^ file to open -> (InputStream ByteString -> IO a) -- ^ function to run -> IO a withFileAsInputStartingAt idx fp m = withBinaryFile fp ReadMode go where go h = do unless (idx == 0) $ hSeek h AbsoluteSeek $ toInteger idx handleToInputStream h >>= m ------------------------------------------------------------------------------ -- | Like 'withFileAsInputStartingAt', except that the 'ByteString' emitted by -- the created 'InputStream' may reuse its buffer. You may only use this -- function if you do not retain references to the generated bytestrings -- emitted. unsafeWithFileAsInputStartingAt :: Int64 -- ^ starting index to seek to -> FilePath -- ^ file to open -> (InputStream ByteString -> IO a) -- ^ function to run -> IO a unsafeWithFileAsInputStartingAt = withFileAsInputStartingAt ------------------------------------------------------------------------------ -- | Open a file for writing and attaches an 'OutputStream' for you to write -- to. The file will be closed on error or completion of your action. withFileAsOutput :: FilePath -- ^ file to open -> (OutputStream ByteString -> IO a) -- ^ function to run -> IO a withFileAsOutput f = withFileAsOutputExt f WriteMode NoBuffering ------------------------------------------------------------------------------ -- | Like 'withFileAsOutput', but allowing you control over the output file -- mode and buffering behaviour. withFileAsOutputExt :: FilePath -- ^ file to open -> IOMode -- ^ mode to write in -> BufferMode -- ^ should we buffer the output? -> (OutputStream ByteString -> IO a) -- ^ function to run -> IO a withFileAsOutputExt fp iomode buffermode m = withBinaryFile fp iomode $ \h -> do hSetBuffering h buffermode handleToOutputStream h >>= m io-streams-1.1.2.2/src/System/IO/Streams/ByteString.hs0000644000000000000000000006241312251607076020566 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} -- | Stream operations on 'ByteString'. module System.IO.Streams.ByteString ( -- * Counting bytes countInput , countOutput -- * Treating strings as streams , fromByteString , fromLazyByteString -- * Input and output , readExactly , takeBytesWhile , writeLazyByteString -- * Stream transformers -- ** Splitting/Joining , splitOn , lines , unlines , words , unwords -- ** Other , giveBytes , giveExactly , takeBytes , throwIfConsumesMoreThan , throwIfProducesMoreThan -- ** Rate limiting , throwIfTooSlow -- * String search , MatchInfo(..) , search -- * Exception types , RateTooSlowException , ReadTooShortException , TooManyBytesReadException , TooManyBytesWrittenException , TooFewBytesWrittenException ) where ------------------------------------------------------------------------------ import Control.Exception (Exception, throwIO) import Control.Monad (when, (>=>)) import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as S import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.ByteString.Unsafe as S import Data.Char (isSpace) import Data.Int (Int64) import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.Time.Clock.POSIX (getPOSIXTime) import Data.Typeable (Typeable) import Prelude hiding (lines, read, takeWhile, unlines, unwords, words) ------------------------------------------------------------------------------ import System.IO.Streams.Combinators (filterM, intersperse, outputFoldM) import System.IO.Streams.Internal (InputStream (..), OutputStream, makeInputStream, makeOutputStream, read, unRead, write) import System.IO.Streams.Internal.Search (MatchInfo (..), search) import System.IO.Streams.List (fromList, writeList) ------------------------------------------------------------------------------ {-# INLINE modifyRef #-} modifyRef :: IORef a -> (a -> a) -> IO () modifyRef ref f = do x <- readIORef ref writeIORef ref $! f x ------------------------------------------------------------------------------ -- | Writes a lazy 'ByteString' to an 'OutputStream'. -- -- Example: -- -- @ -- ghci> Streams.'writeLazyByteString' \"Test\\n\" Streams.'System.IO.Streams.stdout' -- Test -- @ writeLazyByteString :: L.ByteString -- ^ string to write to output -> OutputStream ByteString -- ^ output stream -> IO () writeLazyByteString = writeList . L.toChunks {-# INLINE writeLazyByteString #-} ------------------------------------------------------------------------------ -- | Creates an 'InputStream' from a 'ByteString'. fromByteString :: ByteString -> IO (InputStream ByteString) fromByteString = fromList . (:[]) ------------------------------------------------------------------------------ -- | Creates an 'InputStream' from a lazy 'ByteString'. fromLazyByteString :: L.ByteString -> IO (InputStream ByteString) fromLazyByteString = fromList . L.toChunks ------------------------------------------------------------------------------ -- | Wraps an 'InputStream', counting the number of bytes produced by the -- stream as a side effect. Produces a new 'InputStream' as well as an IO -- action to retrieve the count of bytes produced. -- -- Strings pushed back to the returned 'InputStream' will be pushed back to the -- original stream, and the count of produced bytes will be subtracted -- accordingly. -- -- Example: -- -- @ -- ghci> is <- Streams.'System.IO.Streams.fromList' [\"abc\", \"def\", \"ghi\"::ByteString] -- ghci> (is', getCount) <- Streams.'countInput' is -- ghci> Streams.'read' is' -- Just \"abc\" -- ghci> getCount -- 3 -- ghci> Streams.'unRead' \"bc\" is' -- ghci> getCount -- 1 -- ghci> Streams.'System.IO.Streams.peek' is -- Just \"bc\" -- ghci> Streams.'System.IO.Streams.toList' is' -- [\"bc\",\"def\",\"ghi\"] -- ghci> getCount -- 9 -- @ -- countInput :: InputStream ByteString -> IO (InputStream ByteString, IO Int64) countInput src = do ref <- newIORef (0 :: Int64) return $! (InputStream (prod ref) (pb ref), readIORef ref) where prod ref = read src >>= maybe (return Nothing) (\x -> do modifyRef ref (+ (fromIntegral $ S.length x)) return $! Just x) pb ref s = do modifyRef ref (\x -> x - (fromIntegral $ S.length s)) unRead s src ------------------------------------------------------------------------------ -- | Wraps an 'OutputStream', counting the number of bytes consumed by the -- stream as a side effect. Produces a new 'OutputStream' as well as an IO -- action to retrieve the count of bytes consumed. -- -- Example: -- -- @ -- ghci> (os :: OutputStream ByteString, getList) <- Streams.'System.IO.Streams.listOutputStream' -- ghci> (os', getCount) <- Streams.'countOutput' os -- ghci> Streams.'System.IO.Streams.fromList' [\"abc\", \"def\", \"ghi\"] >>= Streams.'System.IO.Streams.connectTo' os' -- ghci> getList -- [\"abc\",\"def\",\"ghi\"] -- ghci> getCount -- 9 -- @ countOutput :: OutputStream ByteString -> IO (OutputStream ByteString, IO Int64) countOutput = outputFoldM f 0 where f !count s = return z where !c = S.length s !z = toEnum c + count ------------------------------------------------------------------------------ -- | Wraps an 'InputStream', producing a new 'InputStream' that will produce at -- most @n@ bytes, subsequently yielding end-of-stream forever. -- -- Strings pushed back to the returned 'InputStream' will be propagated -- upstream, modifying the count of taken bytes accordingly. -- -- Example: -- -- @ -- ghci> is <- Streams.'System.IO.Streams.fromList' [\"truncated\", \" string\"::ByteString] -- ghci> is' <- Streams.'takeBytes' 9 is -- ghci> Streams.'read' is' -- Just \"truncated\" -- ghci> Streams.'read' is' -- Nothing -- ghci> Streams.'System.IO.Streams.peek' is -- Just \" string\" -- ghci> Streams.'unRead' \"cated\" is' -- ghci> Streams.'System.IO.Streams.peek' is -- Just \"cated\" -- ghci> Streams.'System.IO.Streams.peek' is' -- Just \"cated\" -- ghci> Streams.'read' is' -- Just \"cated\" -- ghci> Streams.'read' is' -- Nothing -- ghci> Streams.'read' is -- Just \" string\" -- @ takeBytes :: Int64 -- ^ maximum number of bytes to read -> InputStream ByteString -- ^ input stream to wrap -> IO (InputStream ByteString) takeBytes k0 src = do kref <- newIORef k0 return $! InputStream (prod kref) (pb kref) where prod kref = do k <- readIORef kref if k <= 0 then return Nothing else read src >>= maybe (return Nothing) (chunk k) where chunk k s = do let l = fromIntegral $ S.length s let k' = k - l if k' <= 0 then let (a,b) = S.splitAt (fromIntegral k) s in do when (not $ S.null b) $ unRead b src writeIORef kref 0 return $! Just a else writeIORef kref k' >> return (Just s) pb kref s = do modifyRef kref (+ (fromIntegral $ S.length s)) unRead s src ------------------------------------------------------------------------------ -- | Splits an 'InputStream' over 'ByteString's using a delimiter predicate. -- -- Note that: -- -- * data pushed back with 'unRead' is *not* propagated upstream here. -- -- * the resulting 'InputStream' may hold an unbounded amount of the -- bytestring in memory waiting for the function to return true, so this -- function should not be used in unsafe contexts. -- -- * the delimiter is NOT included in the output. -- -- * consecutive delimiters are not merged. -- -- Example: -- -- @ -- ghci> Streams.'System.IO.Streams.fromList' [\"the quick br\", \"own fox\"::'ByteString'] >>= -- Streams.'splitOn' (== \' \') >>= Streams.'System.IO.Streams.toList' -- [\"the\",\"quick\",\"brown\",\"\",\"fox\"] -- @ -- splitOn :: (Char -> Bool) -- ^ predicate used to break the input -- stream into chunks -> InputStream ByteString -- ^ input stream -> IO (InputStream ByteString) splitOn p is = do ref <- newIORef id makeInputStream $ start ref where start ref = go where go = read is >>= maybe end chunk end = do dl <- readIORef ref case dl [] of [] -> return Nothing xs -> writeIORef ref id >> (return $! Just $! S.concat xs) chunk s = let (a, b) = S.break p s in if S.null b then modifyRef ref (\f -> f . (a:)) >> go 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] ------------------------------------------------------------------------------ -- | Splits a bytestring 'InputStream' into lines. See 'splitOn' and -- 'Prelude.lines'. -- -- Example: -- -- @ -- ghci> is \<- Streams.'System.IO.Streams.fromList' [\"Hello,\\n world!\"] >>= Streams.'lines' -- ghci> replicateM 3 (Streams.'read' is) -- [Just \"Hello\", Just \", world!\", Nothing] -- @ -- -- Note that this may increase the chunk size if the input contains extremely -- long lines. lines :: InputStream ByteString -> IO (InputStream ByteString) lines = splitOn (== '\n') ------------------------------------------------------------------------------ -- | Splits a bytestring 'InputStream' into words. See 'splitOn' and -- 'Prelude.words'. -- -- Example: -- -- @ -- ghci> is \<- Streams.'System.IO.Streams.fromList' [\"Hello, world!\"] >>= Streams.'words' -- ghci> replicateM 3 (Streams.'read' is) -- [Just \"Hello,\", Just \"world!\", Nothing] -- @ -- -- Note that this may increase the chunk size if the input contains extremely -- long words. words :: InputStream ByteString -> IO (InputStream ByteString) words = splitOn isSpace >=> filterM (return . not . S.all isSpace) ------------------------------------------------------------------------------ -- | Intersperses string chunks sent to the given 'OutputStream' with newlines. -- See 'intersperse' and 'Prelude.unlines'. -- -- @ -- ghci> os <- Streams.'unlines' Streams.'System.IO.Streams.stdout' -- ghci> Streams.'write' (Just \"Hello,\") os -- Hello -- ghci> Streams.'write' Nothing os -- ghci> Streams.'write' (Just \"world!\") os -- world! -- @ unlines :: OutputStream ByteString -> IO (OutputStream ByteString) unlines os = makeOutputStream $ \m -> do write m os case m of Nothing -> return $! () Just _ -> write (Just "\n") os ------------------------------------------------------------------------------ -- | Intersperses string chunks sent to the given 'OutputStream' with spaces. -- See 'intersperse' and 'Prelude.unwords'. -- -- @ -- ghci> os <- Streams.'unwords' Streams.'System.IO.Streams.stdout' -- ghci> forM_ [Just \"Hello,\", Nothing, Just \"world!\\n\"] $ \w -> Streams.'write' w os -- Hello, world! -- @ unwords :: OutputStream ByteString -> IO (OutputStream ByteString) unwords = intersperse " " ------------------------------------------------------------------------------ -- | Thrown by 'throwIfProducesMoreThan' when too many bytes were read from the -- original 'InputStream'. data TooManyBytesReadException = TooManyBytesReadException deriving (Typeable) instance Show TooManyBytesReadException where show TooManyBytesReadException = "Too many bytes read" instance Exception TooManyBytesReadException ------------------------------------------------------------------------------ -- | Thrown by 'giveExactly' when too few bytes were written to the produced -- 'OutputStream'. data TooFewBytesWrittenException = TooFewBytesWrittenException deriving (Typeable) instance Show TooFewBytesWrittenException where show TooFewBytesWrittenException = "Too few bytes written" instance Exception TooFewBytesWrittenException ------------------------------------------------------------------------------ -- | Thrown by 'throwIfConsumesMoreThan' when too many bytes were sent to the -- produced 'OutputStream'. data TooManyBytesWrittenException = TooManyBytesWrittenException deriving (Typeable) instance Show TooManyBytesWrittenException where show TooManyBytesWrittenException = "Too many bytes written" instance Exception TooManyBytesWrittenException ------------------------------------------------------------------------------ -- | Thrown by 'readExactly' when not enough bytes were available on the input. data ReadTooShortException = ReadTooShortException Int deriving (Typeable) instance Show ReadTooShortException where show (ReadTooShortException x) = "Short read, expected " ++ show x ++ " bytes" instance Exception ReadTooShortException ------------------------------------------------------------------------------ -- | Wraps an 'InputStream'. If more than @n@ bytes are produced by this -- stream, 'read' will throw a 'TooManyBytesReadException'. -- -- If a chunk yielded by the input stream would result in more than @n@ bytes -- being produced, 'throwIfProducesMoreThan' will cut the generated string such -- that exactly @n@ bytes are yielded by the returned stream, and the -- /subsequent/ read will throw an exception. Example: -- -- @ -- ghci> is \<- Streams.'System.IO.Streams.fromList' [\"abc\", \"def\", \"ghi\"] >>= -- Streams.'throwIfProducesMoreThan' 5 -- ghci> 'Control.Monad.replicateM' 2 ('read' is) -- [Just \"abc\",Just \"de\"] -- ghci> Streams.'read' is -- *** Exception: Too many bytes read -- @ -- -- Strings pushed back to the returned 'InputStream' will be propagated -- upstream, modifying the count of taken bytes accordingly. Example: -- -- @ -- ghci> is <- Streams.'System.IO.Streams.fromList' [\"abc\", \"def\", \"ghi\"] -- ghci> is' <- Streams.'throwIfProducesMoreThan' 5 is -- ghci> Streams.'read' is' -- Just \"abc\" -- ghci> Streams.'unRead' \"xyz\" is' -- ghci> Streams.'System.IO.Streams.peek' is -- Just \"xyz\" -- ghci> Streams.'read' is -- Just \"xyz\" -- ghci> Streams.'read' is -- Just \"de\" -- ghci> Streams.'read' is -- *** Exception: Too many bytes read -- @ -- throwIfProducesMoreThan :: Int64 -- ^ maximum number of bytes to read -> InputStream ByteString -- ^ input stream -> IO (InputStream ByteString) throwIfProducesMoreThan k0 src = do kref <- newIORef k0 return $! InputStream (prod kref) (pb kref) where prod kref = read src >>= maybe (return Nothing) chunk where chunk s = do k <- readIORef kref let k' = k - l case () of !_ | l == 0 -> return (Just s) | k == 0 -> throwIO TooManyBytesReadException | k' >= 0 -> writeIORef kref k' >> return (Just s) | otherwise -> do let (!a,!b) = S.splitAt (fromEnum k) s writeIORef kref 0 unRead b src return $! Just a where l = toEnum $ S.length s pb kref s = do unRead s src modifyRef kref (+ (fromIntegral $ S.length s)) ------------------------------------------------------------------------------ -- | Reads an @n@-byte ByteString from an input stream. Throws a -- 'ReadTooShortException' if fewer than @n@ bytes were available. -- -- Example: -- -- @ -- ghci> Streams.'System.IO.Streams.fromList' [\"long string\"] >>= Streams.'readExactly' 6 -- \"long s\" -- ghci> Streams.'System.IO.Streams.fromList' [\"short\"] >>= Streams.'readExactly' 6 -- *** Exception: Short read, expected 6 bytes -- @ -- readExactly :: Int -- ^ number of bytes to read -> InputStream ByteString -- ^ input stream -> IO ByteString readExactly n input = go id n where go !dl 0 = return $! S.concat $! dl [] go !dl k = read input >>= maybe (throwIO $ ReadTooShortException n) (\s -> do let l = S.length s if l >= k then do let (a,b) = S.splitAt k s when (not $ S.null b) $ unRead b input return $! S.concat $! dl [a] else go (dl . (s:)) (k - l)) ------------------------------------------------------------------------------ -- | Takes from a stream until the given predicate is no longer satisfied. -- Returns Nothing on end-of-stream, or @Just \"\"@ if the predicate is never -- satisfied. See 'Prelude.takeWhile' and 'Data.ByteString.Char8.takeWhile'. -- -- Example: -- -- @ -- ghci> Streams.'System.IO.Streams.fromList' [\"Hello, world!\"] >>= Streams.'takeBytesWhile' (/= ',') -- Just \"Hello\" -- ghci> import Data.Char -- ghci> Streams.'System.IO.Streams.fromList' [\"7 Samurai\"] >>= Streams.'takeBytesWhile' isAlpha -- Just \"\" -- ghci> Streams.'System.IO.Streams.fromList' [] >>= Streams.'takeBytesWhile' isAlpha -- Nothing -- @ takeBytesWhile :: (Char -> Bool) -- ^ predicate -> InputStream ByteString -- ^ input stream -> IO (Maybe ByteString) takeBytesWhile p input = read input >>= maybe (return Nothing) (go id) where go dl !s | S.null b = read input >>= maybe finish (go dl') | otherwise = unRead b input >> finish where (a, b) = S.span p s dl' = dl . (a:) finish = return $! Just $! S.concat $! dl [a] ------------------------------------------------------------------------------ -- | Wraps an 'OutputStream', producing a new stream that will pass along at -- most @n@ bytes to the wrapped stream, throwing any subsequent input away. -- -- Example: -- -- @ -- ghci> (os :: OutputStream ByteString, getList) <- Streams.'System.IO.Streams.listOutputStream' -- ghci> os' <- Streams.'giveBytes' 6 os -- ghci> Streams.'System.IO.Streams.fromList' [\"long \", \"string\"] >>= Streams.'System.IO.Streams.connectTo' os' -- ghci> getList -- [\"long \",\"s\"] -- @ giveBytes :: Int64 -- ^ maximum number of bytes to send -- to the wrapped stream -> OutputStream ByteString -- ^ output stream to wrap -> IO (OutputStream ByteString) giveBytes k0 str = do kref <- newIORef k0 makeOutputStream $ sink kref where sink _ Nothing = write Nothing str sink kref mb@(Just x) = do k <- readIORef kref let l = fromIntegral $ S.length x let k' = k - l if k' < 0 then do let a = S.take (fromIntegral k) x when (not $ S.null a) $ write (Just a) str writeIORef kref 0 else writeIORef kref k' >> write mb str ------------------------------------------------------------------------------ -- | Wraps an 'OutputStream', producing a new stream that will pass along -- exactly @n@ bytes to the wrapped stream. If the stream is sent more or fewer -- than the given number of bytes, the resulting stream will throw an exception -- (either 'TooFewBytesWrittenException' or 'TooManyBytesWrittenException') -- during a call to 'write'. -- -- Example: -- -- @ -- ghci> is <- Streams.'System.IO.Streams.fromList' [\"ok\"] -- ghci> Streams.'System.IO.Streams.outputToList' (Streams.'giveExactly' 2 >=> Streams.'System.IO.Streams.connect' is) -- [\"ok\"] -- ghci> is <- Streams.'System.IO.Streams.fromList' [\"ok\"] -- ghci> Streams.'System.IO.Streams.outputToList' (Streams.'giveExactly' 1 >=> Streams.'System.IO.Streams.connect' is) -- *** Exception: Too many bytes written -- ghci> is <- Streams.'System.IO.Streams.fromList' [\"ok\"] -- ghci> Streams.'System.IO.Streams.outputToList' (Streams.'giveExactly' 3 >=> Streams.'System.IO.Streams.connect' is) -- *** Exception: Too few bytes written -- @ giveExactly :: Int64 -> OutputStream ByteString -> IO (OutputStream ByteString) giveExactly k0 os = do ref <- newIORef k0 makeOutputStream $ go ref where go ref chunk = do !n <- readIORef ref case chunk of Nothing -> if n /= 0 then throwIO TooFewBytesWrittenException else return $! () Just s -> let n' = n - fromIntegral (S.length s) in if n' < 0 then throwIO TooManyBytesWrittenException else do writeIORef ref n' write chunk os ------------------------------------------------------------------------------ -- | Wraps an 'OutputStream', producing a new stream that will pass along at -- most @n@ bytes to the wrapped stream. If more than @n@ bytes are sent to the -- outer stream, a 'TooManyBytesWrittenException' will be thrown. -- -- /Note/: if more than @n@ bytes are sent to the outer stream, -- 'throwIfConsumesMoreThan' will not necessarily send the first @n@ bytes -- through to the wrapped stream before throwing the exception. -- -- Example: -- -- @ -- ghci> (os :: OutputStream ByteString, getList) <- Streams.'System.IO.Streams.listOutputStream' -- ghci> os' <- Streams.'throwIfConsumesMoreThan' 5 os -- ghci> Streams.'System.IO.Streams.fromList' [\"short\"] >>= Streams.'System.IO.Streams.connectTo' os' -- ghci> getList -- [\"short\"] -- ghci> os'' <- Streams.'throwIfConsumesMoreThan' 5 os -- ghci> Streams.'System.IO.Streams.fromList' [\"long\", \"string\"] >>= Streams.'System.IO.Streams.connectTo' os'' -- *** Exception: Too many bytes written -- @ throwIfConsumesMoreThan :: Int64 -- ^ maximum number of bytes to send to the -- wrapped stream -> OutputStream ByteString -- ^ output stream to wrap -> IO (OutputStream ByteString) throwIfConsumesMoreThan k0 str = do kref <- newIORef k0 makeOutputStream $ sink kref where sink _ Nothing = write Nothing str sink kref mb@(Just x) = do k <- readIORef kref let l = toEnum $ S.length x let k' = k - l if k' < 0 then throwIO TooManyBytesWrittenException else writeIORef kref k' >> write mb str ------------------------------------------------------------------------------ -- | Gets the current posix time getTime :: IO Double getTime = realToFrac `fmap` getPOSIXTime ------------------------------------------------------------------------------ -- | Thrown by 'throwIfTooSlow' if input is not being produced fast enough by -- the given 'InputStream'. -- data RateTooSlowException = RateTooSlowException deriving (Typeable) instance Show RateTooSlowException where show RateTooSlowException = "Input rate too slow" instance Exception RateTooSlowException ------------------------------------------------------------------------------ -- | Rate-limits an input stream. If the input stream is not read from faster -- than the given rate, reading from the wrapped stream will throw a -- 'RateTooSlowException'. -- -- Strings pushed back to the returned 'InputStream' will be propagated up to -- the original stream. throwIfTooSlow :: IO () -- ^ action to bump timeout -> Double -- ^ minimum data rate, in bytes per second -> Int -- ^ amount of time in seconds to wait before -- data rate calculation takes effect -> InputStream ByteString -- ^ input stream -> IO (InputStream ByteString) throwIfTooSlow !bump !minRate !minSeconds' !stream = do !_ <- bump startTime <- getTime bytesRead <- newIORef (0 :: Int64) return $! InputStream (prod startTime bytesRead) (pb bytesRead) where prod startTime bytesReadRef = read stream >>= maybe (return Nothing) chunk where chunk s = do let slen = S.length s now <- getTime let !delta = now - startTime nb <- readIORef bytesReadRef let newBytes = nb + fromIntegral slen when (delta > minSeconds + 1 && (fromIntegral newBytes / (delta - minSeconds)) < minRate) $ throwIO RateTooSlowException -- otherwise, bump the timeout and return the input !_ <- bump writeIORef bytesReadRef newBytes return $! Just s pb bytesReadRef s = do modifyRef bytesReadRef $ \x -> x - (fromIntegral $ S.length s) unRead s stream minSeconds = fromIntegral minSeconds' io-streams-1.1.2.2/src/System/IO/Streams/Internal/0000755000000000000000000000000012251607076017706 5ustar0000000000000000io-streams-1.1.2.2/src/System/IO/Streams/Internal/Search.hs0000644000000000000000000001736612251607076021464 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} module System.IO.Streams.Internal.Search ( search , MatchInfo(..) ) where ------------------------------------------------------------------------------ import Control.Monad (when) import Control.Monad.IO.Class (liftIO) import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as S import Data.ByteString.Unsafe as S import qualified Data.Vector.Unboxed as V import qualified Data.Vector.Unboxed.Mutable as MV import Prelude hiding (last, read) ------------------------------------------------------------------------------ import System.IO.Streams.Internal (InputStream) import qualified System.IO.Streams.Internal as Streams ------------------------------------------------------------------------------ -- | 'MatchInfo' provides match information when performing string search. data MatchInfo = Match {-# UNPACK #-} !ByteString | NoMatch {-# UNPACK #-} !ByteString deriving (Show, Eq) ------------------------------------------------------------------------------ -- | Does the given needle match the haystack over the given ranges of indices? matches :: ByteString -- ^ needle -> Int -- ^ needle start -> Int -- ^ needle end (inclusive) -> ByteString -- ^ haystack -> Int -- ^ haystack start -> Int -- ^ haystack end (inclusive) -> Bool matches !needle !nstart !nend' !haystack !hstart !hend' = go nend' hend' where go !nend !hend = if nend < nstart || hend < hstart then True else let !nc = S.unsafeIndex needle nend !hc = S.unsafeIndex haystack hend in if nc /= hc then False else go (nend-1) (hend-1) {-# INLINE matches #-} ------------------------------------------------------------------------------ -- | Given a 'ByteString' to look for (the \"needle\") and an 'InputStream', -- produces a new 'InputStream' which yields data of type 'MatchInfo'. -- -- Example: -- -- @ -- ghci> 'System.IO.Streams.fromList' [\"food\", \"oof\", \"oodles\", \"ok\"] >>= -- 'search' \"foo\" >>= 'System.IO.Streams.toList' -- ['Match' \"foo\",'NoMatch' \"d\",'NoMatch' \"oo\",'Match' \"foo\",'NoMatch' \"dlesok\"] -- @ -- -- Uses the Boyer-Moore-Horspool algorithm -- (). search :: ByteString -- ^ \"needle\" to look for -> InputStream ByteString -- ^ input stream to wrap -> IO (InputStream MatchInfo) search needle stream = Streams.fromGenerator $ lookahead nlen >>= either finishAndEOF startSearch where -------------------------------------------------------------------------- finishAndEOF x = if S.null x then return $! () else Streams.yield $! NoMatch x -------------------------------------------------------------------------- startSearch !haystack = if S.null haystack then lookahead nlen >>= either finishAndEOF startSearch else go 0 where ---------------------------------------------------------------------- !hlen = S.length haystack ---------------------------------------------------------------------- go !hidx | hend >= hlen = crossBound hidx | otherwise = do let match = matches needle 0 last haystack hidx hend if match then do let !nomatch = S.take hidx haystack let !aftermatch = S.drop (hend + 1) haystack produceMatch nomatch aftermatch else do -- skip ahead let c = S.unsafeIndex haystack hend let !skip = V.unsafeIndex table $ fromEnum c go (hidx + skip) where !hend = hidx + nlen - 1 ---------------------------------------------------------------------- mkCoeff hidx = let !ll = hlen - hidx !nm = nlen - ll in (ll, nm) ---------------------------------------------------------------------- crossBound !hidx0 = do let (!leftLen, needMore) = mkCoeff hidx0 lookahead needMore >>= either (\s -> finishAndEOF $ S.append haystack s) (runNext hidx0 leftLen needMore) where runNext !hidx !leftLen !needMore !nextHaystack = do let match1 = matches needle leftLen last nextHaystack 0 (needMore-1) let match2 = matches needle 0 (leftLen-1) haystack hidx (hlen-1) if match1 && match2 then do let !nomatch = S.take hidx haystack let !aftermatch = S.drop needMore nextHaystack produceMatch nomatch aftermatch else do let c = S.unsafeIndex nextHaystack $ needMore - 1 let p = V.unsafeIndex table (fromEnum c) if p < leftLen then do let !hidx' = hidx + p let (!leftLen', needMore') = mkCoeff hidx' let !nextlen = S.length nextHaystack if nextlen < needMore' then -- this should be impossibly rare lookahead (needMore' - nextlen) >>= either (\s -> finishAndEOF $ S.concat [ haystack , nextHaystack , s ]) (\s -> runNext hidx' leftLen' needMore' $ S.append nextHaystack s) else runNext hidx' leftLen' needMore' nextHaystack else do let sidx = p - leftLen let (!crumb, rest) = S.splitAt sidx nextHaystack Streams.yield $! NoMatch $! S.append haystack crumb startSearch rest -------------------------------------------------------------------------- produceMatch nomatch aftermatch = do when (not $ S.null nomatch) $ Streams.yield $! NoMatch nomatch Streams.yield $! Match needle startSearch aftermatch -------------------------------------------------------------------------- !nlen = S.length needle !last = nlen - 1 -------------------------------------------------------------------------- !table = V.create $ do t <- MV.replicate 256 nlen go t where go !t = go' 0 where go' !i | i >= last = return t | otherwise = do let c = fromEnum $ S.unsafeIndex needle i MV.unsafeWrite t c (last - i) go' $! i+1 -------------------------------------------------------------------------- lookahead n = go id n where go dlist !k = liftIO (Streams.read stream) >>= maybe eof chunk where eof = return $! Left $! S.concat $ dlist [] chunk x = if r <= 0 then return $! Right $! S.concat $ d' [] else go d' r where l = S.length x r = k - l d' = dlist . (x:) io-streams-1.1.2.2/src/System/IO/Streams/Internal/Attoparsec.hs0000644000000000000000000001252212251607076022351 0ustar0000000000000000-- | This module provides support for parsing values from 'InputStream's using -- @attoparsec@. {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} module System.IO.Streams.Internal.Attoparsec ( -- * Parsing ParseException(..) , parseFromStream , parseFromStreamInternal , parserToInputStream ) 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 Data.Typeable (Typeable) import Prelude hiding (read) ------------------------------------------------------------------------------ import System.IO.Streams.Internal (InputStream) import qualified System.IO.Streams.Internal as Streams ------------------------------------------------------------------------------ -- | An exception raised when parsing fails. data ParseException = ParseException String deriving (Typeable) instance Show ParseException where show (ParseException s) = "Parse exception: " ++ s 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 #-} ------------------------------------------------------------------------------ -- | 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 -> IO r parseFromStreamInternal parseFunc feedFunc parser is = Streams.read is >>= maybe (finish $ parseFunc parser "") (\s -> if S.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 finish k = let k' = feedFunc (feedFunc k "") "" in case k' of Fail x _ _ -> leftover x >> err k' Partial _ -> err k' -- should be impossible Done x r -> leftover x >> return r err r = let (Left s) = eitherResult r in throwIO $ ParseException s 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 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 #-}