conduit 1.0.17.1 → 1.1.0
raw patch · 13 files changed
+184/−1745 lines, 13 filesdep +exceptionsdep ~resourcet
Dependencies added: exceptions
Dependency ranges changed: resourcet
Files
- Data/Conduit.hs +16/−16
- Data/Conduit/Binary.hs +0/−432
- Data/Conduit/Internal.hs +51/−6
- Data/Conduit/Lazy.hs +0/−36
- Data/Conduit/Lift.hs +104/−103
- Data/Conduit/Text.hs +0/−439
- Data/Conduit/Util.hs +0/−57
- System/PosixFile.hsc +0/−88
- System/Win32File.hsc +0/−97
- conduit.cabal +6/−19
- test/Data/Conduit/ExtraSpec.hs +0/−71
- test/main.hs +7/−381
- test/random binary
Data/Conduit.hs view
@@ -43,6 +43,7 @@ , mapOutput , mapOutputMaybe , mapInput+ , passthroughSink -- * Connect-and-resume , ResumableSource@@ -78,28 +79,16 @@ -- ** ZipConduit , ZipConduit (..) , sequenceConduits-- -- * Convenience re-exports- , ResourceT- , MonadResource- , MonadThrow (..)- , MonadUnsafeIO (..)- , runResourceT- , ExceptionT (..)- , runExceptionT_- , runException- , runException_- , MonadBaseControl ) where -import Control.Monad.Trans.Resource import Control.Monad.Trans.Class (lift)-import Data.Conduit.Internal hiding (await, awaitForever, yield, yieldOr, leftover, bracketP, addCleanup, transPipe, mapOutput, mapOutputMaybe, mapInput)+import Data.Conduit.Internal hiding (await, awaitForever, yield, yieldOr, leftover, bracketP, addCleanup, transPipe, mapOutput, mapOutputMaybe, mapInput, yieldM) import qualified Data.Conduit.Internal as CI import Control.Monad.Morph (hoist) import Control.Monad (liftM, forever, when, unless) import Control.Applicative (Applicative (..)) import Data.Traversable (Traversable (..))+import Control.Monad.Trans.Resource (MonadResource) -- Define fixity of all our operators infixr 0 $$@@ -130,8 +119,11 @@ -- -- Leftover data from the @Conduit@ will be discarded. --+-- Note: Since version 1.0.18, this operator has been generalized to be+-- identical to @=$=@.+-- -- Since 0.4.0-($=) :: Monad m => Source m a -> Conduit a m b -> Source m b+($=) :: Monad m => Conduit a m b -> ConduitM b c m r -> ConduitM a c m r ConduitM src $= ConduitM con = ConduitM $ pipeL src con {-# INLINE ($=) #-} @@ -142,8 +134,11 @@ -- -- Leftover data returned from the @Sink@ will be discarded. --+-- Note: Since version 1.0.18, this operator has been generalized to be+-- identical to @=$=@.+-- -- Since 0.4.0-(=$) :: Monad m => Conduit a m b -> Sink b m c -> Sink a m c+(=$) :: Monad m => Conduit a m b -> ConduitM b c m r -> ConduitM a c m r ConduitM con =$ ConduitM sink = ConduitM $ pipeL con sink {-# INLINE (=$) #-} @@ -178,6 +173,10 @@ yield = ConduitM . CI.yield {-# INLINE [1] yield #-} +yieldM :: Monad m => m o -> ConduitM i o m ()+yieldM = ConduitM . CI.yieldM+{-# INLINE [1] yieldM #-}+ {-# RULES "yield o >> p" forall o (p :: ConduitM i o m r). yield o >> p = ConduitM (HaveOutput (unConduitM p) (return ()) o) ; "mapM_ yield" mapM_ yield = ConduitM . sourceList@@ -187,6 +186,7 @@ if b then ConduitM (HaveOutput (unConduitM p) (return ()) o) else p ; "unless yield next" forall b o p. unless b (yield o) >> p = if b then p else ConduitM (HaveOutput (unConduitM p) (return ()) o)+ ; "lift m >>= yield" forall m. lift m >>= yield = yieldM m #-} -- | Provide a single piece of leftover input to be consumed by the next
− Data/Conduit/Binary.hs
@@ -1,432 +0,0 @@-{-# LANGUAGE CPP, RankNTypes #-}--- | Functions for interacting with bytes.-module Data.Conduit.Binary- ( -- * Files and @Handle@s-- -- | Note that most of these functions live in the @MonadResource@ monad- -- to ensure resource finalization even in the presence of exceptions. In- -- order to run such code, you will need to use @runResourceT@.-- -- ** Sources- sourceFile- , sourceHandle- , sourceHandleUnsafe- , sourceIOHandle- , sourceFileRange- , sourceHandleRange- -- ** Sinks- , sinkFile- , sinkHandle- , sinkIOHandle- -- ** Conduits- , conduitFile- , conduitHandle- -- * Utilities- -- ** Sources- , sourceLbs- -- ** Sinks- , head- , dropWhile- , take- , drop- , sinkCacheLength- , sinkLbs- , mapM_- -- ** Conduits- , isolate- , takeWhile- , Data.Conduit.Binary.lines- ) where--import Prelude hiding (head, take, drop, takeWhile, dropWhile, mapM_)-import qualified Data.ByteString as S-import qualified Data.ByteString.Lazy as L-import Data.Conduit-import Data.Conduit.List (sourceList, consume)-import Control.Exception (assert, finally)-import Control.Monad (unless, when)-import Control.Monad.IO.Class (liftIO, MonadIO)-import Control.Monad.Trans.Resource (allocate, release)-import Control.Monad.Trans.Class (lift)-import qualified System.IO as IO-import Data.Word (Word8, Word64)-import Control.Applicative ((<$>))-import System.Directory (getTemporaryDirectory, removeFile)-import Data.ByteString.Lazy.Internal (defaultChunkSize)-#if CABAL_OS_WINDOWS-import qualified System.Win32File as F-#elif NO_HANDLES-import qualified System.PosixFile as F-#endif-import Data.ByteString.Internal (ByteString (PS), inlinePerformIO)-import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)-import Foreign.ForeignPtr (touchForeignPtr)-import Foreign.Ptr (plusPtr)-import Foreign.Storable (peek)-import GHC.ForeignPtr (mallocPlainForeignPtrBytes)---- | Stream the contents of a file as binary data.------ Since 0.3.0-sourceFile :: MonadResource m- => FilePath- -> Producer m S.ByteString-sourceFile fp =-#if CABAL_OS_WINDOWS || NO_HANDLES- bracketP- (F.openRead fp)- F.close- loop- where- loop h = liftIO (F.read h) >>= maybe (return ()) (\bs -> yield bs >> loop h)-#else- sourceIOHandle (IO.openBinaryFile fp IO.ReadMode)-#endif---- | Stream the contents of a 'IO.Handle' as binary data. Note that this--- function will /not/ automatically close the @Handle@ when processing--- completes, since it did not acquire the @Handle@ in the first place.------ Since 0.3.0-sourceHandle :: MonadIO m- => IO.Handle- -> Producer m S.ByteString-sourceHandle h =- loop- where- loop = do- bs <- liftIO (S.hGetSome h defaultChunkSize)- if S.null bs- then return ()- else yield bs >> loop---- | Same as @sourceHandle@, but instead of allocating a new buffer for each--- incoming chunk of data, reuses the same buffer. Therefore, the @ByteString@s--- yielded by this function are not referentially transparent between two--- different @yield@s.------ This function will be slightly more efficient than @sourceHandle@ by--- avoiding allocations and reducing garbage collections, but should only be--- used if you can guarantee that you do not reuse a @ByteString@ (or any slice--- thereof) between two calls to @await@.------ Since 1.0.12-sourceHandleUnsafe :: MonadIO m => IO.Handle -> Source m ByteString-sourceHandleUnsafe handle = do- fptr <- liftIO $ mallocPlainForeignPtrBytes defaultChunkSize- let ptr = unsafeForeignPtrToPtr fptr- loop = do- count <- liftIO $ IO.hGetBuf handle ptr defaultChunkSize- when (count > 0) $ do- yield (PS fptr 0 count)- loop-- loop-- liftIO $ touchForeignPtr fptr---- | An alternative to 'sourceHandle'.--- Instead of taking a pre-opened 'IO.Handle', it takes an action that opens--- a 'IO.Handle' (in read mode), so that it can open it only when needed--- and closed it as soon as possible.------ Since 0.3.0-sourceIOHandle :: MonadResource m- => IO IO.Handle- -> Producer m S.ByteString-sourceIOHandle alloc = bracketP alloc IO.hClose sourceHandle---- | Stream all incoming data to the given 'IO.Handle'. Note that this function--- will /not/ automatically close the @Handle@ when processing completes.------ Since 0.3.0-sinkHandle :: MonadIO m- => IO.Handle- -> Consumer S.ByteString m ()-sinkHandle h = awaitForever $ liftIO . S.hPut h---- | An alternative to 'sinkHandle'.--- Instead of taking a pre-opened 'IO.Handle', it takes an action that opens--- a 'IO.Handle' (in write mode), so that it can open it only when needed--- and close it as soon as possible.------ Since 0.3.0-sinkIOHandle :: MonadResource m- => IO IO.Handle- -> Consumer S.ByteString m ()-sinkIOHandle alloc = bracketP alloc IO.hClose sinkHandle---- | Stream the contents of a file as binary data, starting from a certain--- offset and only consuming up to a certain number of bytes.------ Since 0.3.0-sourceFileRange :: MonadResource m- => FilePath- -> Maybe Integer -- ^ Offset- -> Maybe Integer -- ^ Maximum count- -> Producer m S.ByteString-sourceFileRange fp offset count = bracketP- (IO.openBinaryFile fp IO.ReadMode)- IO.hClose- (\h -> sourceHandleRange h offset count)---- | Stream the contents of a handle as binary data, starting from a certain--- offset and only consuming up to a certain number of bytes.------ Since 1.0.8-sourceHandleRange :: MonadIO m- => IO.Handle- -> Maybe Integer -- ^ Offset- -> Maybe Integer -- ^ Maximum count- -> Producer m S.ByteString-sourceHandleRange handle offset count = do- case offset of- Nothing -> return ()- Just off -> liftIO $ IO.hSeek handle IO.AbsoluteSeek off- case count of- Nothing -> pullUnlimited- Just c -> pullLimited (fromInteger c)- where- pullUnlimited = do- bs <- liftIO $ S.hGetSome handle 4096- if S.null bs- then return ()- else do- yield bs- pullUnlimited-- pullLimited c = do- bs <- liftIO $ S.hGetSome handle (min c 4096)- let c' = c - S.length bs- assert (c' >= 0) $- if S.null bs- then return ()- else do- yield bs- pullLimited c'---- | Stream all incoming data to the given file.------ Since 0.3.0-sinkFile :: MonadResource m- => FilePath- -> Consumer S.ByteString m ()-#if NO_HANDLES-sinkFile fp =- bracketP- (F.openWrite fp)- F.close- loop- where- loop h = awaitForever $ liftIO . F.write h-#else-sinkFile fp = sinkIOHandle (IO.openBinaryFile fp IO.WriteMode)-#endif---- | Stream the contents of the input to a file, and also send it along the--- pipeline. Similar in concept to the Unix command @tee@.------ Since 0.3.0-conduitFile :: MonadResource m- => FilePath- -> Conduit S.ByteString m S.ByteString-conduitFile fp = bracketP- (IO.openBinaryFile fp IO.WriteMode)- IO.hClose- conduitHandle---- | Stream the contents of the input to a @Handle@, and also send it along the--- pipeline. Similar in concept to the Unix command @tee@. Like @sourceHandle@,--- does not close the handle on completion. Related to: @conduitFile@.------ Since 1.0.9-conduitHandle :: MonadIO m => IO.Handle -> Conduit S.ByteString m S.ByteString-conduitHandle h = awaitForever $ \bs -> liftIO (S.hPut h bs) >> yield bs---- | Ensure that only up to the given number of bytes are consume by the inner--- sink. Note that this does /not/ ensure that all of those bytes are in fact--- consumed.------ Since 0.3.0-isolate :: Monad m- => Int- -> Conduit S.ByteString m S.ByteString-isolate =- loop- where- loop 0 = return ()- loop count = do- mbs <- await- case mbs of- Nothing -> return ()- Just bs -> do- let (a, b) = S.splitAt count bs- case count - S.length a of- 0 -> do- unless (S.null b) $ leftover b- yield a- count' -> assert (S.null b) $ yield a >> loop count'---- | Return the next byte from the stream, if available.------ Since 0.3.0-head :: Monad m => Consumer S.ByteString m (Maybe Word8)-head = do- mbs <- await- case mbs of- Nothing -> return Nothing- Just bs ->- case S.uncons bs of- Nothing -> head- Just (w, bs') -> leftover bs' >> return (Just w)---- | Return all bytes while the predicate returns @True@.------ Since 0.3.0-takeWhile :: Monad m => (Word8 -> Bool) -> Conduit S.ByteString m S.ByteString-takeWhile p =- loop- where- loop = await >>= maybe (return ()) go-- go bs- | S.null x = next- | otherwise = yield x >> next- where- next = if S.null y then loop else leftover y- (x, y) = S.span p bs---- | Ignore all bytes while the predicate returns @True@.------ Since 0.3.0-dropWhile :: Monad m => (Word8 -> Bool) -> Consumer S.ByteString m ()-dropWhile p =- loop- where- loop = do- mbs <- await- case S.dropWhile p <$> mbs of- Nothing -> return ()- Just bs- | S.null bs -> loop- | otherwise -> leftover bs---- | Take the given number of bytes, if available.------ Since 0.3.0-take :: Monad m => Int -> Consumer S.ByteString m L.ByteString-take 0 = return L.empty-take n0 = go n0 id- where- go n front =- await >>= maybe (return $ L.fromChunks $ front []) go'- where- go' bs =- case S.length bs `compare` n of- LT -> go (n - S.length bs) (front . (bs:))- EQ -> return $ L.fromChunks $ front [bs]- GT ->- let (x, y) = S.splitAt n bs- in assert (not $ S.null y) $ leftover y >> return (L.fromChunks $ front [x])---- | Drop up to the given number of bytes.------ Since 0.5.0-drop :: Monad m => Int -> Consumer S.ByteString m ()-drop 0 = return ()-drop n0 = go n0- where- go n =- await >>= maybe (return ()) go'- where- go' bs =- case S.length bs `compare` n of- LT -> go (n - S.length bs)- EQ -> return ()- GT ->- let y = S.drop n bs- in assert (not $ S.null y) $ leftover y >> return ()---- | Split the input bytes into lines. In other words, split on the LF byte--- (10), and strip it from the output.------ Since 0.3.0-lines :: Monad m => Conduit S.ByteString m S.ByteString-lines =- loop id- where- loop front = await >>= maybe (finish front) (go front)-- finish front =- let final = front S.empty- in unless (S.null final) (yield final)-- go sofar more =- case S.uncons second of- Just (_, second') -> yield (sofar first) >> go id second'- Nothing ->- let rest = sofar more- in loop $ S.append rest- where- (first, second) = S.breakByte 10 more---- | Stream the chunks from a lazy bytestring.------ Since 0.5.0-sourceLbs :: Monad m => L.ByteString -> Producer m S.ByteString-sourceLbs = sourceList . L.toChunks---- | Stream the input data into a temp file and count the number of bytes--- present. When complete, return a new @Source@ reading from the temp file--- together with the length of the input in bytes.------ All resources will be cleaned up automatically.------ Since 1.0.5-sinkCacheLength :: (MonadResource m1, MonadResource m2)- => Sink S.ByteString m1 (Word64, Source m2 S.ByteString)-sinkCacheLength = do- tmpdir <- liftIO getTemporaryDirectory- (releaseKey, (fp, h)) <- allocate- (IO.openBinaryTempFile tmpdir "conduit.cache")- (\(fp, h) -> IO.hClose h `finally` removeFile fp)- len <- sinkHandleLen h- liftIO $ IO.hClose h- return (len, sourceFile fp >> release releaseKey)- where- sinkHandleLen :: MonadResource m => IO.Handle -> Sink S.ByteString m Word64- sinkHandleLen h =- loop 0- where- loop x =- await >>= maybe (return x) go- where- go bs = do- liftIO $ S.hPut h bs- loop $ x + fromIntegral (S.length bs)---- | Consume a stream of input into a lazy bytestring. Note that no lazy I\/O--- is performed, but rather all content is read into memory strictly.------ Since 1.0.5-sinkLbs :: Monad m => Sink S.ByteString m L.ByteString-sinkLbs = fmap L.fromChunks consume--mapM_BS :: Monad m => (Word8 -> m ()) -> S.ByteString -> m ()-mapM_BS f (PS fptr offset len) = do- let start = unsafeForeignPtrToPtr fptr `plusPtr` offset- end = start `plusPtr` len- loop ptr- | ptr >= end = inlinePerformIO (touchForeignPtr fptr) `seq` return ()- | otherwise = do- f (inlinePerformIO (peek ptr))- loop (ptr `plusPtr` 1)- loop start-{-# INLINE mapM_BS #-}---- | Perform a computation on each @Word8@ in a stream.------ Since 1.0.10-mapM_ :: Monad m => (Word8 -> m ()) -> Consumer S.ByteString m ()-mapM_ f = awaitForever (lift . mapM_BS f)-{-# INLINE mapM_ #-}
Data/Conduit/Internal.hs view
@@ -24,6 +24,7 @@ , awaitE , awaitForever , yield+ , yieldM , yieldOr , leftover -- * Finalization@@ -68,6 +69,7 @@ , zipSources , zipSourcesApp , zipConduitApp+ , passthroughSink ) where import Control.Applicative (Applicative (..))@@ -154,10 +156,7 @@ liftIO = lift . liftIO instance MonadThrow m => MonadThrow (Pipe l i o u m) where- monadThrow = lift . monadThrow--instance MonadActive m => MonadActive (Pipe l i o u m) where- monadActive = lift monadActive+ throwM = lift . throwM instance Monad m => Monoid (Pipe l i o u m ()) where mempty = return ()@@ -228,7 +227,7 @@ -- -- Since 1.0.0 newtype ConduitM i o m r = ConduitM { unConduitM :: Pipe i i o () m r }- deriving (Functor, Applicative, Monad, MonadIO, MonadTrans, MonadThrow, MonadActive, MonadResource, MFunctor)+ deriving (Functor, Applicative, Monad, MonadIO, MonadTrans, MonadThrow, MFunctor) instance MonadReader r m => MonadReader r (ConduitM i o m) where ask = ConduitM ask@@ -258,6 +257,9 @@ instance MonadBase base m => MonadBase base (ConduitM i o m) where liftBase = lift . liftBase +instance MonadResource m => MonadResource (ConduitM i o m) where+ liftResourceT = lift . liftResourceT+ instance Monad m => Monoid (ConduitM i o m ()) where mempty = return () mappend = (>>)@@ -346,6 +348,10 @@ yield = HaveOutput (Done ()) (return ()) {-# INLINE [1] yield #-} +yieldM :: Monad m => m o -> Pipe l i o u m ()+yieldM = PipeM . liftM (HaveOutput (Done ()) (return ()))+{-# INLINE [1] yieldM #-}+ -- | Similar to @yield@, but additionally takes a finalizer to be run if the -- downstream @Pipe@ terminates. --@@ -360,7 +366,9 @@ {-# RULES "CI.yield o >> p" forall o (p :: Pipe l i o u m r). yield o >> p = HaveOutput p (return ()) o ; "mapM_ CI.yield" mapM_ yield = sourceList- ; "CI.yieldOr o c >> p" forall o c (p :: Pipe l i o u m r). yieldOr o c >> p = HaveOutput p c o #-}+ ; "CI.yieldOr o c >> p" forall o c (p :: Pipe l i o u m r). yieldOr o c >> p = HaveOutput p c o+ ; "lift m >>= CI.yield" forall m. lift m >>= yield = yieldM m+ #-} -- | Provide a single piece of leftover input to be consumed by the next pipe -- in the current monadic binding.@@ -1052,3 +1060,40 @@ x <- liftIO $ I.readIORef ref when x final return (liftIO (I.writeIORef ref False) >> src, final')++-- | Turn a @Sink@ into a @Conduit@ in the following way:+--+-- * All input passed to the @Sink@ is yielded downstream.+--+-- * When the @Sink@ finishes processing, the result is passed to the provided to the finalizer function.+--+-- Note that the @Sink@ will stop receiving input as soon as the downstream it+-- is connected to shuts down.+--+-- An example usage would be to write the result of a @Sink@ to some mutable+-- variable while allowing other processing to continue.+--+-- Since 1.1.0+passthroughSink :: Monad m+ => Sink i m r+ -> (r -> m ()) -- ^ finalizer+ -> Conduit i m i+passthroughSink (ConduitM sink0) final =+ ConduitM $ go [] sink0+ where+ go _ (Done r) = do+ lift $ final r+ awaitForever yield+ go is (Leftover sink i) = go (i:is) sink+ go _ (HaveOutput _ _ o) = absurd o+ go is (PipeM mx) = do+ x <- lift mx+ go is x+ go (i:is) (NeedInput next _) = go is (next i)+ go [] (NeedInput next done) = do+ mx <- await+ case mx of+ Nothing -> go [] (done ())+ Just x -> do+ yield x+ go [] (next x)
− Data/Conduit/Lazy.hs
@@ -1,36 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}--- | Use lazy I\/O for consuming the contents of a source. Warning: All normal--- warnings of lazy I\/O apply. In particular, if you are using this with a--- @ResourceT@ transformer, you must force the list to be evaluated before--- exiting the @ResourceT@.-module Data.Conduit.Lazy- ( lazyConsume- ) where--import Data.Conduit-import Data.Conduit.Internal (Pipe (..), unConduitM)-import System.IO.Unsafe (unsafeInterleaveIO)-import Control.Monad.Trans.Control (liftBaseOp_)-import Control.Monad.Trans.Resource (MonadActive (monadActive))---- | Use lazy I\/O to consume all elements from a @Source@.------ This function relies on 'monadActive' to determine if the underlying monadic--- state has been closed.------ Since 0.3.0-lazyConsume :: (MonadBaseControl IO m, MonadActive m) => Source m a -> m [a]-lazyConsume =- go . unConduitM- where- go (Done _) = return []- go (HaveOutput src _ x) = do- xs <- liftBaseOp_ unsafeInterleaveIO $ go src- return $ x : xs- go (PipeM msrc) = liftBaseOp_ unsafeInterleaveIO $ do- a <- monadActive- if a- then msrc >>= go- else return []- go (NeedInput _ c) = go (c ())- go (Leftover p _) = go p
Data/Conduit/Lift.hs view
@@ -13,9 +13,9 @@ catchErrorC, -- liftCatchError, - -- * ExceptionT- runExceptionC,- catchExceptionC,+ -- * CatchT+ runCatchC,+ catchCatchC, -- * MaybeT maybeC,@@ -25,40 +25,40 @@ readerC, runReaderC, - -- * StateT+ -- * StateT, lazy+ stateLC,+ runStateLC,+ evalStateLC,+ execStateLC,++ -- ** Strict stateC, runStateC, evalStateC, execStateC, - -- ** Strict- stateSC,- runStateSC,- evalStateSC,- execStateSC,+ -- * WriterT, lazy+ writerLC,+ runWriterLC,+ execWriterLC, - -- * WriterT+ -- ** Strict writerC, runWriterC, execWriterC, - -- ** Strict- writerSC,- runWriterSC,- execWriterSC,+ -- * RWST, lazy+ rwsLC,+ runRWSLC,+ evalRWSLC,+ execRWSLC, - -- * RWST+ -- ** Strict rwsC, runRWSC, evalRWSC, execRWSC, - -- ** Strict- rwsSC,- runRWSSC,- evalRWSSC,- execRWSSC,- -- * Utilities distribute@@ -85,6 +85,7 @@ import qualified Control.Monad.Trans.State.Lazy as SL import qualified Control.Monad.Trans.Writer.Lazy as WL import qualified Control.Monad.Trans.RWS.Lazy as RWSL+import Control.Monad.Catch.Pure (CatchT (runCatchT)) catAwaitLifted@@ -173,47 +174,47 @@ go (NeedInput x y) = NeedInput (go . x) (go . y) {-# INLINABLE catchErrorC #-} --- | Run 'ExceptionT' in the base monad+-- | Run 'CatchT' in the base monad ----- Since 1.0.14-runExceptionC+-- Since 1.1.0+runCatchC :: Monad m =>- ConduitM i o (ExceptionT m) r -> ConduitM i o m (Either SomeException r)-runExceptionC =+ ConduitM i o (CatchT m) r -> ConduitM i o m (Either SomeException r)+runCatchC = ConduitM . go . unConduitM where go (Done r) = Done (Right r) go (PipeM mp) = PipeM $ do- eres <- runExceptionT mp+ eres <- runCatchT mp return $ case eres of Left e -> Done $ Left e Right p -> go p go (Leftover p i) = Leftover (go p) i- go (HaveOutput p f o) = HaveOutput (go p) (runExceptionT f >> return ()) o+ go (HaveOutput p f o) = HaveOutput (go p) (runCatchT f >> return ()) o go (NeedInput x y) = NeedInput (go . x) (go . y)-{-# INLINABLE runExceptionC #-}+{-# INLINABLE runCatchC #-} -- | Catch an exception in the base monad ----- Since 1.0.14-catchExceptionC+-- Since 1.1.0+catchCatchC :: Monad m =>- ConduitM i o (ExceptionT m) r- -> (SomeException -> ConduitM i o (ExceptionT m) r)- -> ConduitM i o (ExceptionT m) r-catchExceptionC c0 h =+ ConduitM i o (CatchT m) r+ -> (SomeException -> ConduitM i o (CatchT m) r)+ -> ConduitM i o (CatchT m) r+catchCatchC c0 h = ConduitM $ go $ unConduitM c0 where go (Done r) = Done r go (PipeM mp) = PipeM $ do- eres <- lift $ runExceptionT mp+ eres <- lift $ runCatchT mp return $ case eres of Left e -> unConduitM $ h e Right p -> go p go (Leftover p i) = Leftover (go p) i go (HaveOutput p f o) = HaveOutput (go p) f o go (NeedInput x y) = NeedInput (go . x) (go . y)-{-# INLINABLE catchExceptionC #-}+{-# INLINABLE catchCatchC #-} -- | Wrap the base monad in 'M.MaybeT' --@@ -274,17 +275,17 @@ -- | Wrap the base monad in 'SL.StateT' -- -- Since 1.0.11-stateC+stateLC :: (Monad m, Monad (t1 (SL.StateT t m)), MonadTrans t1, MFunctor t1) => (t -> t1 m (b, t)) -> t1 (SL.StateT t m) b-stateC k = do+stateLC k = do s <- lift SL.get (r, s') <- hoist lift (k s) lift (SL.put s') return r-{-# INLINABLE stateC #-}+{-# INLINABLE stateLC #-} thread :: Monad m => (r -> s -> res)@@ -307,154 +308,154 @@ -- | Run 'SL.StateT' in the base monad -- -- Since 1.0.11-runStateC+runStateLC :: Monad m => s -> ConduitM i o (SL.StateT s m) r -> ConduitM i o m (r, s)-runStateC = thread (,) SL.runStateT-{-# INLINABLE runStateC #-}+runStateLC = thread (,) SL.runStateT+{-# INLINABLE runStateLC #-} -- | Evaluate 'SL.StateT' in the base monad -- -- Since 1.0.11-evalStateC+evalStateLC :: Monad m => s -> ConduitM i o (SL.StateT s m) r -> ConduitM i o m r-evalStateC s p = fmap fst $ runStateC s p-{-# INLINABLE evalStateC #-}+evalStateLC s p = fmap fst $ runStateLC s p+{-# INLINABLE evalStateLC #-} -- | Execute 'SL.StateT' in the base monad -- -- Since 1.0.11-execStateC+execStateLC :: Monad m => s -> ConduitM i o (SL.StateT s m) r -> ConduitM i o m s-execStateC s p = fmap snd $ runStateC s p-{-# INLINABLE execStateC #-}+execStateLC s p = fmap snd $ runStateLC s p+{-# INLINABLE execStateLC #-} -- | Wrap the base monad in 'SS.StateT' -- -- Since 1.0.11-stateSC+stateC :: (Monad m, Monad (t1 (SS.StateT t m)), MonadTrans t1, MFunctor t1) => (t -> t1 m (b, t)) -> t1 (SS.StateT t m) b-stateSC k = do+stateC k = do s <- lift SS.get (r, s') <- hoist lift (k s) lift (SS.put s') return r-{-# INLINABLE stateSC #-}+{-# INLINABLE stateC #-} -- | Run 'SS.StateT' in the base monad -- -- Since 1.0.11-runStateSC+runStateC :: Monad m => s -> ConduitM i o (SS.StateT s m) r -> ConduitM i o m (r, s)-runStateSC = thread (,) SS.runStateT-{-# INLINABLE runStateSC #-}+runStateC = thread (,) SS.runStateT+{-# INLINABLE runStateC #-} -- | Evaluate 'SS.StateT' in the base monad -- -- Since 1.0.11-evalStateSC+evalStateC :: Monad m => s -> ConduitM i o (SS.StateT s m) r -> ConduitM i o m r-evalStateSC s p = fmap fst $ runStateSC s p-{-# INLINABLE evalStateSC #-}+evalStateC s p = fmap fst $ runStateC s p+{-# INLINABLE evalStateC #-} -- | Execute 'SS.StateT' in the base monad -- -- Since 1.0.11-execStateSC+execStateC :: Monad m => s -> ConduitM i o (SS.StateT s m) r -> ConduitM i o m s-execStateSC s p = fmap snd $ runStateSC s p-{-# INLINABLE execStateSC #-}+execStateC s p = fmap snd $ runStateC s p+{-# INLINABLE execStateC #-} -- | Wrap the base monad in 'WL.WriterT' -- -- Since 1.0.11-writerC+writerLC :: (Monad m, Monad (t (WL.WriterT w m)), MonadTrans t, Monoid w, MFunctor t) => t m (b, w) -> t (WL.WriterT w m) b-writerC p = do+writerLC p = do (r, w) <- hoist lift p lift $ WL.tell w return r-{-# INLINABLE writerC #-}+{-# INLINABLE writerLC #-} -- | Run 'WL.WriterT' in the base monad -- -- Since 1.0.11-runWriterC+runWriterLC :: (Monad m, Monoid w) => ConduitM i o (WL.WriterT w m) r -> ConduitM i o m (r, w)-runWriterC = thread (,) run mempty+runWriterLC = thread (,) run mempty where run m w = do (a, w') <- WL.runWriterT m return (a, w `mappend` w')-{-# INLINABLE runWriterC #-}+{-# INLINABLE runWriterLC #-} -- | Execute 'WL.WriterT' in the base monad -- -- Since 1.0.11-execWriterC+execWriterLC :: (Monad m, Monoid w) => ConduitM i o (WL.WriterT w m) r -> ConduitM i o m w-execWriterC p = fmap snd $ runWriterC p-{-# INLINABLE execWriterC #-}+execWriterLC p = fmap snd $ runWriterLC p+{-# INLINABLE execWriterLC #-} -- | Wrap the base monad in 'WS.WriterT' -- -- Since 1.0.11-writerSC+writerC :: (Monad m, Monad (t (WS.WriterT w m)), MonadTrans t, Monoid w, MFunctor t) => t m (b, w) -> t (WS.WriterT w m) b-writerSC p = do+writerC p = do (r, w) <- hoist lift p lift $ WS.tell w return r-{-# INLINABLE writerSC #-}+{-# INLINABLE writerC #-} -- | Run 'WS.WriterT' in the base monad -- -- Since 1.0.11-runWriterSC+runWriterC :: (Monad m, Monoid w) => ConduitM i o (WS.WriterT w m) r -> ConduitM i o m (r, w)-runWriterSC = thread (,) run mempty+runWriterC = thread (,) run mempty where run m w = do (a, w') <- WS.runWriterT m return (a, w `mappend` w')-{-# INLINABLE runWriterSC #-}+{-# INLINABLE runWriterC #-} -- | Execute 'WS.WriterT' in the base monad -- -- Since 1.0.11-execWriterSC+execWriterC :: (Monad m, Monoid w) => ConduitM i o (WS.WriterT w m) r -> ConduitM i o m w-execWriterSC p = fmap snd $ runWriterSC p-{-# INLINABLE execWriterSC #-}+execWriterC p = fmap snd $ runWriterC p+{-# INLINABLE execWriterC #-} -- | Wrap the base monad in 'RWSL.RWST' -- -- Since 1.0.11-rwsC+rwsLC :: (Monad m, Monad (t1 (RWSL.RWST t w t2 m)), MonadTrans t1, Monoid w, MFunctor t1) => (t -> t2 -> t1 m (b, t2, w)) -> t1 (RWSL.RWST t w t2 m) b-rwsC k = do+rwsLC k = do i <- lift RWSL.ask s <- lift RWSL.get (r, s', w) <- hoist lift (k i s)@@ -462,60 +463,60 @@ RWSL.put s' RWSL.tell w return r-{-# INLINABLE rwsC #-}+{-# INLINABLE rwsLC #-} -- | Run 'RWSL.RWST' in the base monad -- -- Since 1.0.11-runRWSC+runRWSLC :: (Monad m, Monoid w) => r -> s -> ConduitM i o (RWSL.RWST r w s m) res -> ConduitM i o m (res, s, w)-runRWSC r s0 = thread toRes run (s0, mempty)+runRWSLC r s0 = thread toRes run (s0, mempty) where toRes a (s, w) = (a, s, w) run m (s, w) = do (res, s', w') <- RWSL.runRWST m r s return (res, (s', w `mappend` w'))-{-# INLINABLE runRWSC #-}+{-# INLINABLE runRWSLC #-} -- | Evaluate 'RWSL.RWST' in the base monad -- -- Since 1.0.11-evalRWSC+evalRWSLC :: (Monad m, Monoid w) => r -> s -> ConduitM i o (RWSL.RWST r w s m) res -> ConduitM i o m (res, w)-evalRWSC i s p = fmap f $ runRWSC i s p+evalRWSLC i s p = fmap f $ runRWSLC i s p where f x = let (r, _, w) = x in (r, w)-{-# INLINABLE evalRWSC #-}+{-# INLINABLE evalRWSLC #-} -- | Execute 'RWSL.RWST' in the base monad -- -- Since 1.0.11-execRWSC+execRWSLC :: (Monad m, Monoid w) => r -> s -> ConduitM i o (RWSL.RWST r w s m) res -> ConduitM i o m (s, w)-execRWSC i s p = fmap f $ runRWSC i s p+execRWSLC i s p = fmap f $ runRWSLC i s p where f x = let (_, s2, w2) = x in (s2, w2)-{-# INLINABLE execRWSC #-}+{-# INLINABLE execRWSLC #-} -- | Wrap the base monad in 'RWSS.RWST' -- -- Since 1.0.11-rwsSC+rwsC :: (Monad m, Monad (t1 (RWSS.RWST t w t2 m)), MonadTrans t1, Monoid w, MFunctor t1) => (t -> t2 -> t1 m (b, t2, w)) -> t1 (RWSS.RWST t w t2 m) b-rwsSC k = do+rwsC k = do i <- lift RWSS.ask s <- lift RWSS.get (r, s', w) <- hoist lift (k i s)@@ -523,48 +524,48 @@ RWSS.put s' RWSS.tell w return r-{-# INLINABLE rwsSC #-}+{-# INLINABLE rwsC #-} -- | Run 'RWSS.RWST' in the base monad -- -- Since 1.0.11-runRWSSC+runRWSC :: (Monad m, Monoid w) => r -> s -> ConduitM i o (RWSS.RWST r w s m) res -> ConduitM i o m (res, s, w)-runRWSSC r s0 = thread toRes run (s0, mempty)+runRWSC r s0 = thread toRes run (s0, mempty) where toRes a (s, w) = (a, s, w) run m (s, w) = do (res, s', w') <- RWSS.runRWST m r s return (res, (s', w `mappend` w'))-{-# INLINABLE runRWSSC #-}+{-# INLINABLE runRWSC #-} -- | Evaluate 'RWSS.RWST' in the base monad -- -- Since 1.0.11-evalRWSSC+evalRWSC :: (Monad m, Monoid w) => r -> s -> ConduitM i o (RWSS.RWST r w s m) res -> ConduitM i o m (res, w)-evalRWSSC i s p = fmap f $ runRWSSC i s p+evalRWSC i s p = fmap f $ runRWSC i s p where f x = let (r, _, w) = x in (r, w)-{-# INLINABLE evalRWSSC #-}+{-# INLINABLE evalRWSC #-} -- | Execute 'RWSS.RWST' in the base monad -- -- Since 1.0.11-execRWSSC+execRWSC :: (Monad m, Monoid w) => r -> s -> ConduitM i o (RWSS.RWST r w s m) res -> ConduitM i o m (s, w)-execRWSSC i s p = fmap f $ runRWSSC i s p+execRWSC i s p = fmap f $ runRWSC i s p where f x = let (_, s2, w2) = x in (s2, w2)-{-# INLINABLE execRWSSC #-}+{-# INLINABLE execRWSC #-}
− Data/Conduit/Text.hs
@@ -1,439 +0,0 @@-{-# LANGUAGE DeriveDataTypeable, RankNTypes #-}--- |--- Copyright: 2011 Michael Snoyman, 2010-2011 John Millikin--- License: MIT------ Handle streams of text.------ Parts of this code were taken from enumerator and adapted for conduits.-module Data.Conduit.Text- (-- -- * Text codecs- Codec- , encode- , decode- , utf8- , utf16_le- , utf16_be- , utf32_le- , utf32_be- , ascii- , iso8859_1- , lines- , linesBounded- , TextException (..)- , takeWhile- , dropWhile- , take- , drop- , foldLines- , withLine- , decodeUtf8- , encodeUtf8- ) where--import qualified Prelude-import Prelude hiding (head, drop, takeWhile, lines, zip, zip3, zipWith, zipWith3, take, dropWhile)--import qualified Control.Exception as Exc-import qualified Data.ByteString as B-import qualified Data.ByteString.Char8 as B8-import Data.Char (ord)-import qualified Data.Text as T-import qualified Data.Text.Encoding as TE-import Data.Word (Word8)-import Data.Typeable (Typeable)--import Data.Conduit-import qualified Data.Conduit.List as CL-import Control.Monad.Trans.Class (lift)-import Control.Monad (unless,when)-import Data.Text.StreamDecoding---- | A specific character encoding.------ Since 0.3.0-data Codec = Codec- { codecName :: T.Text- , codecEncode- :: T.Text- -> (B.ByteString, Maybe (TextException, T.Text))- , codecDecode- :: B.ByteString- -> (T.Text, Either- (TextException, B.ByteString)- B.ByteString)- }- | NewCodec T.Text (T.Text -> B.ByteString) (B.ByteString -> DecodeResult)--instance Show Codec where- showsPrec d c = showParen (d > 10) $- showString "Codec " . shows (codecName c)------- | Emit each line separately------ Since 0.4.1-lines :: Monad m => Conduit T.Text m T.Text-lines =- loop id- where- loop front = await >>= maybe (finish front) (go front)-- finish front =- let final = front T.empty- in unless (T.null final) (yield final)-- go sofar more =- case T.uncons second of- Just (_, second') -> yield (sofar first') >> go id second'- Nothing ->- let rest = sofar more- in loop $ T.append rest- where- (first', second) = T.break (== '\n') more------ | Variant of the lines function with an integer parameter.--- The text length of any emitted line--- never exceeds the value of the paramater. Whenever--- this is about to happen a LengthExceeded exception--- is thrown. This function should be used instead--- of the lines function whenever we are dealing with--- user input (e.g. a file upload) because we can't be sure that--- user input won't have extraordinarily large lines which would--- require large amounts of memory if consumed.-linesBounded :: MonadThrow m => Int -> Conduit T.Text m T.Text-linesBounded maxLineLen =- loop 0 id- where- loop len front = await >>= maybe (finish front) (go len front)-- finish front =- let final = front T.empty- in unless (T.null final) (yield final)- go len sofar more =- case T.uncons second of- Just (_, second') -> do- let toYield = sofar first'- len' = len + T.length first'- when (len' > maxLineLen)- (lift $ monadThrow (LengthExceeded maxLineLen))- yield toYield- go 0 id second'- Nothing -> do- let len' = len + T.length more- when (len' > maxLineLen) $- (lift $ monadThrow (LengthExceeded maxLineLen))- let rest = sofar more- loop len' $ T.append rest- where- (first', second) = T.break (== '\n') more------ | Convert text into bytes, using the provided codec. If the codec is--- not capable of representing an input character, an exception will be thrown.------ Since 0.3.0-encode :: MonadThrow m => Codec -> Conduit T.Text m B.ByteString-encode (NewCodec _ enc _) = CL.map enc-encode codec = CL.mapM $ \t -> do- let (bs, mexc) = codecEncode codec t- maybe (return bs) (monadThrow . fst) mexc----- | Convert bytes into text, using the provided codec. If the codec is--- not capable of decoding an input byte sequence, an exception will be thrown.------ Since 0.3.0-decode :: MonadThrow m => Codec -> Conduit B.ByteString m T.Text-decode (NewCodec name _ start) =- loop 0 start- where- loop consumed dec =- await >>= maybe finish go- where- finish =- case dec B.empty of- DecodeResultSuccess _ _ -> return ()- DecodeResultFailure t rest -> onFailure B.empty t rest- {-# INLINE finish #-}-- go bs | B.null bs = loop consumed dec- go bs =- case dec bs of- DecodeResultSuccess t dec' -> do- let consumed' = consumed + B.length bs- next = do- unless (T.null t) (yield t)- loop consumed' dec'- in consumed' `seq` next- DecodeResultFailure t rest -> onFailure bs t rest-- onFailure bs t rest = do- unless (T.null t) (yield t)- leftover rest -- rest will never be null, no need to check- let consumed' = consumed + B.length bs - B.length rest- monadThrow $ NewDecodeException name consumed' (B.take 4 rest)- {-# INLINE onFailure #-}-decode codec =- loop id- where- loop front = await >>= maybe (finish front) (go front)-- finish front =- case B.uncons $ front B.empty of- Nothing -> return ()- Just (w, _) -> lift $ monadThrow $ DecodeException codec w-- go front bs' =- case extra of- Left (exc, _) -> lift $ monadThrow exc- Right bs'' -> yield text >> loop (B.append bs'')- where- (text, extra) = codecDecode codec bs- bs = front bs'---- |--- Since 0.3.0-data TextException = DecodeException Codec Word8- | EncodeException Codec Char- | LengthExceeded Int- | TextException Exc.SomeException- | NewDecodeException !T.Text !Int !B.ByteString- deriving Typeable-instance Show TextException where- show (DecodeException codec w) = concat- [ "Error decoding legacy Data.Conduit.Text codec "- , show codec- , " when parsing byte: "- , show w- ]- show (EncodeException codec c) = concat- [ "Error encoding legacy Data.Conduit.Text codec "- , show codec- , " when parsing char: "- , show c- ]- show (LengthExceeded i) = "Data.Conduit.Text.linesBounded: line too long: " ++ show i- show (TextException se) = "Data.Conduit.Text.TextException: " ++ show se- show (NewDecodeException codec consumed next) = concat- [ "Data.Conduit.Text.decode: Error decoding stream of "- , T.unpack codec- , " bytes. Error encountered in stream at offset "- , show consumed- , ". Encountered at byte sequence "- , show next- ]-instance Exc.Exception TextException---- |--- Since 0.3.0-utf8 :: Codec-utf8 = NewCodec (T.pack "UTF-8") TE.encodeUtf8 streamUtf8---- |--- Since 0.3.0-utf16_le :: Codec-utf16_le = NewCodec (T.pack "UTF-16-LE") TE.encodeUtf16LE streamUtf16LE---- |--- Since 0.3.0-utf16_be :: Codec-utf16_be = NewCodec (T.pack "UTF-16-BE") TE.encodeUtf16BE streamUtf16BE---- |--- Since 0.3.0-utf32_le :: Codec-utf32_le = NewCodec (T.pack "UTF-32-LE") TE.encodeUtf32LE streamUtf32LE---- |--- Since 0.3.0-utf32_be :: Codec-utf32_be = NewCodec (T.pack "UTF-32-BE") TE.encodeUtf32BE streamUtf32BE---- |--- Since 0.3.0-ascii :: Codec-ascii = Codec name enc dec where- name = T.pack "ASCII"- enc text = (bytes, extra) where- (safe, unsafe) = T.span (\c -> ord c <= 0x7F) text- bytes = B8.pack (T.unpack safe)- extra = if T.null unsafe- then Nothing- else Just (EncodeException ascii (T.head unsafe), unsafe)-- dec bytes = (text, extra) where- (safe, unsafe) = B.span (<= 0x7F) bytes- text = T.pack (B8.unpack safe)- extra = if B.null unsafe- then Right B.empty- else Left (DecodeException ascii (B.head unsafe), unsafe)---- |--- Since 0.3.0-iso8859_1 :: Codec-iso8859_1 = Codec name enc dec where- name = T.pack "ISO-8859-1"- enc text = (bytes, extra) where- (safe, unsafe) = T.span (\c -> ord c <= 0xFF) text- bytes = B8.pack (T.unpack safe)- extra = if T.null unsafe- then Nothing- else Just (EncodeException iso8859_1 (T.head unsafe), unsafe)-- dec bytes = (T.pack (B8.unpack bytes), Right B.empty)---- |------ Since 1.0.8-takeWhile :: Monad m- => (Char -> Bool)- -> Conduit T.Text m T.Text-takeWhile p =- loop- where- loop = await >>= maybe (return ()) go- go t =- case T.span p t of- (x, y)- | T.null y -> yield x >> loop- | otherwise -> yield x >> leftover y---- |------ Since 1.0.8-dropWhile :: Monad m- => (Char -> Bool)- -> Consumer T.Text m ()-dropWhile p =- loop- where- loop = await >>= maybe (return ()) go- go t- | T.null x = loop- | otherwise = leftover x- where- x = T.dropWhile p t---- |------ Since 1.0.8-take :: Monad m => Int -> Conduit T.Text m T.Text-take =- loop- where- loop i = await >>= maybe (return ()) (go i)- go i t- | diff == 0 = yield t- | diff < 0 =- let (x, y) = T.splitAt i t- in yield x >> leftover y- | otherwise = yield t >> loop diff- where- diff = i - T.length t---- |------ Since 1.0.8-drop :: Monad m => Int -> Consumer T.Text m ()-drop =- loop- where- loop i = await >>= maybe (return ()) (go i)- go i t- | diff == 0 = return ()- | diff < 0 = leftover $ T.drop i t- | otherwise = loop diff- where- diff = i - T.length t---- |------ Since 1.0.8-foldLines :: Monad m- => (a -> ConduitM T.Text o m a)- -> a- -> ConduitM T.Text o m a-foldLines f =- start- where- start a = CL.peek >>= maybe (return a) (const $ loop $ f a)-- loop consumer = do- a <- takeWhile (/= '\n') =$= do- a <- CL.map (T.filter (/= '\r')) =$= consumer- CL.sinkNull- return a- drop 1- start a---- |------ Since 1.0.8-withLine :: Monad m- => Sink T.Text m a- -> Consumer T.Text m (Maybe a)-withLine consumer = toConsumer $ do- mx <- CL.peek- case mx of- Nothing -> return Nothing- Just _ -> do- x <- takeWhile (/= '\n') =$ do- x <- CL.map (T.filter (/= '\r')) =$ consumer- CL.sinkNull- return x- drop 1- return $ Just x---- | Decode a stream of UTF8-encoded bytes into a stream of text, throwing an--- exception on invalid input.------ Since 1.0.15-decodeUtf8 :: MonadThrow m => Conduit B.ByteString m T.Text-decodeUtf8 = decode utf8- {- no meaningful performance advantage- CI.ConduitM (loop 0 streamUtf8)- where- loop consumed dec =- CI.NeedInput go finish- where- finish () =- case dec B.empty of- DecodeResultSuccess _ _ -> return ()- DecodeResultFailure t rest -> onFailure B.empty t rest- {-# INLINE finish #-}-- go bs | B.null bs = CI.NeedInput go finish- go bs =- case dec bs of- DecodeResultSuccess t dec' -> do- let consumed' = consumed + B.length bs- next' = loop consumed' dec'- next- | T.null t = next'- | otherwise = CI.HaveOutput next' (return ()) t- in consumed' `seq` next- DecodeResultFailure t rest -> onFailure bs t rest-- onFailure bs t rest = do- unless (T.null t) (CI.yield t)- unless (B.null rest) (CI.leftover rest)- let consumed' = consumed + B.length bs - B.length rest- monadThrow $ NewDecodeException (T.pack "UTF-8") consumed' (B.take 4 rest)- {-# INLINE onFailure #-}- -}-{-# INLINE decodeUtf8 #-}---- | Encode a stream of text into a stream of bytes.------ Since 1.0.15-encodeUtf8 :: Monad m => Conduit T.Text m B.ByteString-encodeUtf8 = CL.map TE.encodeUtf8-{-# INLINE encodeUtf8 #-}
− Data/Conduit/Util.hs
@@ -1,57 +0,0 @@--- | Various utility functions versions of @conduit@.-module Data.Conduit.Util- ( -- * Misc- zip- , zipSources- , zipSinks- , passthroughSink- ) where--import Prelude hiding (zip)-import Data.Conduit.Internal (Pipe (..), Source, Sink, ConduitM (..), Conduit, awaitForever, yield, await, zipSinks, zipSources)-import Data.Void (absurd)-import Control.Monad.Trans.Class (lift)---- | Deprecated synonym for 'zipSources'.------ Since 0.3.0-zip :: Monad m => Source m a -> Source m b -> Source m (a, b)-zip = zipSources-{-# DEPRECATED zip "Use zipSources instead" #-}---- | Turn a @Sink@ into a @Conduit@ in the following way:------ * All input passed to the @Sink@ is yielded downstream.------ * When the @Sink@ finishes processing, the result is passed to the provided to the finalizer function.------ Note that the @Sink@ will stop receiving input as soon as the downstream it--- is connected to shuts down.------ An example usage would be to write the result of a @Sink@ to some mutable--- variable while allowing other processing to continue.------ Since 1.0.10-passthroughSink :: Monad m- => Sink i m r- -> (r -> m ()) -- ^ finalizer- -> Conduit i m i-passthroughSink (ConduitM sink0) final =- ConduitM $ go [] sink0- where- go _ (Done r) = do- lift $ final r- awaitForever yield- go is (Leftover sink i) = go (i:is) sink- go _ (HaveOutput _ _ o) = absurd o- go is (PipeM mx) = do- x <- lift mx- go is x- go (i:is) (NeedInput next _) = go is (next i)- go [] (NeedInput next done) = do- mx <- await- case mx of- Nothing -> go [] (done ())- Just x -> do- yield x- go [] (next x)
− System/PosixFile.hsc
@@ -1,88 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-module System.PosixFile- ( openRead- , openWrite- , read- , write- , close- ) where--import Foreign.C.String (CString, withCString)-import Foreign.Ptr (castPtr)-import Foreign.Marshal.Alloc (mallocBytes, free)-#if __GLASGOW_HASKELL__ >= 704-import Foreign.C.Types (CInt (..))-#else-import Foreign.C.Types (CInt)-#endif-import Foreign.C.Error (throwErrno)-import Foreign.Ptr (Ptr)-import Data.Bits (Bits, (.|.))-import Data.Word (Word8)-import qualified Data.ByteString as S-import qualified Data.ByteString.Unsafe as BU-import Prelude hiding (read)--#include <fcntl.h>--newtype Flag = Flag CInt- deriving (Num, Bits, Show, Eq)--#{enum Flag, Flag- , oRdonly = O_RDONLY- , oWronly = O_WRONLY- , oCreat = O_CREAT- }--foreign import ccall "open"- c_open :: CString -> Flag -> CInt -> IO CInt--foreign import ccall "read"- c_read :: FD -> Ptr Word8 -> CInt -> IO CInt--foreign import ccall "write"- c_write :: FD -> Ptr Word8 -> CInt -> IO CInt--foreign import ccall "close"- close :: FD -> IO ()--newtype FD = FD CInt--openRead :: FilePath -> IO FD-openRead fp = do- h <- withCString fp $ \str -> c_open str oRdonly 438 -- == octal 666- if h < 0- then throwErrno $ "Could not open file: " ++ fp- else return $ FD h--openWrite :: FilePath -> IO FD-openWrite fp = do- h <- withCString fp $ \str -> c_open str (oWronly .|. oCreat) 438 -- == octal 666- if h < 0- then throwErrno $ "Could not open file: " ++ fp- else return $ FD h--read :: FD -> IO (Maybe S.ByteString)-read fd = do- cstr <- mallocBytes 4096- len <- c_read fd cstr 4096- if len == 0- then free cstr >> return Nothing- else fmap Just $ BU.unsafePackCStringFinalizer- cstr- (fromIntegral len)- (free cstr)--write :: FD -> S.ByteString -> IO ()-write _ bs | S.null bs = return ()-write fd bs = do- (written, len) <- BU.unsafeUseAsCStringLen bs $ \(cstr, len') -> do- let len = fromIntegral len'- written <- c_write fd (castPtr cstr) len- return (written, len)- case () of- ()- | written == len -> return ()- | written <= 0 -> throwErrno $ "Error writing to file"- | otherwise -> write fd $ BU.unsafeDrop (fromIntegral $ len - written) bs
− System/Win32File.hsc
@@ -1,97 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-module System.Win32File- ( openRead- , read- , close- ) where--import Foreign.C.String (CString)-import Foreign.Ptr (castPtr)-import Foreign.Marshal.Alloc (mallocBytes, free)-import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)-#if __GLASGOW_HASKELL__ >= 704-import Foreign.C.Types (CInt (..))-#else-import Foreign.C.Types (CInt)-#endif-import Foreign.C.Error (throwErrnoIfMinus1Retry)-import Foreign.Ptr (Ptr)-import Data.Bits (Bits, (.|.))-import qualified Data.ByteString as S-import qualified Data.ByteString.Unsafe as BU-import qualified Data.ByteString.Internal as BI-import Data.Text (pack)-import Data.Text.Encoding (encodeUtf16LE)-import Data.Word (Word8)-import Prelude hiding (read)-import GHC.ForeignPtr (mallocPlainForeignPtrBytes)---#include <fcntl.h>-#include <Share.h>-#include <SYS/Stat.h>-#include <errno.h>--newtype OFlag = OFlag CInt- deriving (Num, Bits, Show, Eq)--#{enum OFlag, OFlag- , oBinary = _O_BINARY- , oRdonly = _O_RDONLY- , oWronly = _O_WRONLY- , oCreat = _O_CREAT- }--newtype SHFlag = SHFlag CInt- deriving (Num, Bits, Show, Eq)--#{enum SHFlag, SHFlag- , shDenyno = _SH_DENYNO- }--newtype PMode = PMode CInt- deriving (Num, Bits, Show, Eq)--#{enum PMode, PMode- , pIread = _S_IREAD- , pIwrite = _S_IWRITE- }--foreign import ccall "_wsopen"- c_wsopen :: CString -> OFlag -> SHFlag -> PMode -> IO CInt--foreign import ccall "_read"- c_read :: FD -> Ptr Word8 -> CInt -> IO CInt--foreign import ccall "_write"- c_write :: FD -> Ptr Word8 -> CInt -> IO CInt--foreign import ccall "_close"- close :: FD -> IO ()--newtype FD = FD CInt--openRead :: FilePath -> IO FD-openRead fp = do- -- need to append a null char- -- note that useAsCString is not sufficient, as we need to have two- -- null octets to account for UTF16 encoding- let bs = encodeUtf16LE $ pack $ fp ++ "\0"- h <- BU.unsafeUseAsCString bs $ \str ->- throwErrnoIfMinus1Retry "System.Win32File.openRead" $- c_wsopen- str- (oBinary .|. oRdonly)- shDenyno- pIread- return $ FD h--read :: FD -> IO (Maybe S.ByteString)-read fd = do- fp <- mallocPlainForeignPtrBytes 4096- withForeignPtr fp $ \p -> do- len <- throwErrnoIfMinus1Retry "System.Win32File.read" $ c_read fd p 4096- if len == 0- then return $! Nothing- else return $! Just $! BI.PS fp 0 (fromIntegral len)
conduit.cabal view
@@ -1,11 +1,13 @@ Name: conduit-Version: 1.0.17.1+Version: 1.1.0 Synopsis: Streaming data processing library. Description: @conduit@ is a solution to the streaming data problem, allowing for production, transformation, and consumption of streams of data in constant memory. It is an alternative to lazy I\/O which guarantees deterministic resource handling, and fits in the same general solution space as @enumerator@\/@iteratee@ and @pipes@. For a tutorial, please visit <https://haskell.fpcomplete.com/user/snoyberg/library-documentation/conduit-overview>. . Release history: .+ [1.1] Refactoring into conduit and conduit-extra packages. Core functionality is now in conduit, whereas most common helper modules (including Text, Binary, Zlib, etc) are in conduit-extra. To upgrade to this version, there should only be import list and conduit file changes necessary.+ . [1.0] Simplified the user-facing interface back to the Source, Sink, and Conduit types, with Producer and Consumer for generic code. Error messages have been simplified, and optional leftovers and upstream terminators have been removed from the external API. Some long-deprecated functions were finally removed. . [0.5] The internals of the package are now separated to the .Internal module, leaving only the higher-level interface in the advertised API. Internally, switched to a @Leftover@ constructor and slightly tweaked the finalization semantics.@@ -27,30 +29,16 @@ Build-type: Simple Cabal-version: >=1.8 Homepage: http://github.com/snoyberg/conduit-extra-source-files: test/main.hs, test/random--flag nohandles- default: False- Description: experimental code to use raw system calls in place of handles. Not recommended for general use+extra-source-files: test/main.hs Library- if os(windows)- cpp-options: -DCABAL_OS_WINDOWS- other-modules: System.Win32File- else- other-modules: System.PosixFile- if flag(nohandles)- cpp-options: -DNO_HANDLES Exposed-modules: Data.Conduit- Data.Conduit.Binary- Data.Conduit.Text Data.Conduit.List- Data.Conduit.Lazy Data.Conduit.Internal- Data.Conduit.Util Data.Conduit.Lift Build-depends: base >= 4.3 && < 5- , resourcet >= 0.4.3 && < 0.5+ , resourcet >= 1.1 && < 1.2+ , exceptions , lifted-base >= 0.1 , transformers-base >= 0.4.1 && < 0.5 , monad-control >= 0.3.1 && < 0.4@@ -69,7 +57,6 @@ hs-source-dirs: test main-is: main.hs other-modules: Data.Conduit.Extra.ZipConduitSpec- Data.Conduit.ExtraSpec type: exitcode-stdio-1.0 cpp-options: -DTEST build-depends: conduit
− test/Data/Conduit/ExtraSpec.hs
@@ -1,71 +0,0 @@-module Data.Conduit.ExtraSpec where--import Data.Conduit-import Test.Hspec-import Test.Hspec.QuickCheck-import Data.Conduit.List (isolate, peek, consume)-import qualified Data.Conduit.List as CL-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import qualified Data.ByteString as S-import qualified Data.Conduit.Text as CT--spec :: Spec-spec = describe "Data.Conduit.Extra" $ do- it "basic test" $ do- let sink2 :: Sink a IO (Maybe a, Maybe a)- sink2 = do- ma1 <- fuseLeftovers id (isolate 10) peek- ma2 <- peek- return (ma1, ma2)-- source = yield 1 >> yield 2- res <- source $$ sink2- res `shouldBe` (Just 1, Just 1)-- it "get leftovers" $ do- let sink2 :: Sink a IO ([a], [a], [a])- sink2 = do- (x, y) <- fuseReturnLeftovers (isolate 2) peek3- z <- CL.consume- return (x, y, z)-- peek3 = do- x <- CL.take 3- mapM_ leftover $ reverse x- return x-- source = mapM_ yield [1..5]- res <- source $$ sink2- res `shouldBe` ([1..2], [1..2], [3..5])-- it "multiple values" $ do- let sink2 :: Sink a IO ([a], Maybe a)- sink2 = do- ma1 <- fuseLeftovers id (isolate 10) peek3- ma2 <- peek- return (ma1, ma2)-- peek3 = do- x <- CL.take 3- mapM_ leftover $ reverse x- return x-- source = mapM_ yield [1..5]- res <- source $$ sink2- res `shouldBe` ([1..3], Just 1)-- prop "more complex" $ \ss cnt -> do- let ts = map T.pack ss- src = mapM_ (yield . T.encodeUtf8) ts- conduit = CL.map T.decodeUtf8- sink = CT.take cnt =$ consume- undo = return . T.encodeUtf8 . T.concat- res <- src $$ do- x <- fuseLeftovers undo conduit sink- y <- consume- return (T.concat x, T.decodeUtf8 $ S.concat y)- res `shouldBe` T.splitAt cnt (T.concat ts)--main :: IO ()-main = hspec spec
test/main.hs view
@@ -7,13 +7,9 @@ import Control.Exception (IOException) import qualified Data.Conduit as C import qualified Data.Conduit.Lift as C-import qualified Data.Conduit.Util as C import qualified Data.Conduit.Internal as CI import qualified Data.Conduit.List as CL-import qualified Data.Conduit.Lazy as CLazy-import qualified Data.Conduit.Binary as CB-import qualified Data.Conduit.Text as CT-import Data.Conduit (runResourceT)+import Control.Monad.Trans.Resource as C (runExceptionT, runResourceT) import Data.Maybe (fromMaybe,catMaybes,fromJust) import qualified Data.List as DL import Control.Monad.ST (runST)@@ -41,7 +37,6 @@ import Control.Monad.Error (catchError, throwError, Error) import qualified Data.Map as Map import Control.Arrow (first)-import qualified Data.Conduit.ExtraSpec as ES import qualified Data.Conduit.Extra.ZipConduitSpec as ZipConduit (@=?) :: (Eq a, Show a) => a -> a -> IO ()@@ -169,47 +164,20 @@ ] C.$$ CL.fold (+) 0 x `shouldBe` sum [1..20] - describe "file access" $ do- it "read" $ do- bs <- S.readFile "conduit.cabal"- bss <- runResourceT $ CB.sourceFile "conduit.cabal" C.$$ CL.consume- bs @=? S.concat bss-- it "read range" $ do- S.writeFile "tmp" "0123456789"- bss <- runResourceT $ CB.sourceFileRange "tmp" (Just 2) (Just 3) C.$$ CL.consume- S.concat bss `shouldBe` "234"-- it "write" $ do- runResourceT $ CB.sourceFile "conduit.cabal" C.$$ CB.sinkFile "tmp"- bs1 <- S.readFile "conduit.cabal"- bs2 <- S.readFile "tmp"- bs1 @=? bs2-- it "conduit" $ do- runResourceT $ CB.sourceFile "conduit.cabal"- C.$= CB.conduitFile "tmp"- C.$$ CB.sinkFile "tmp2"- bs1 <- S.readFile "conduit.cabal"- bs2 <- S.readFile "tmp"- bs3 <- S.readFile "tmp2"- bs1 @=? bs2- bs1 @=? bs3- describe "zipping" $ do it "zipping two small lists" $ do- res <- runResourceT $ C.zipSources (CL.sourceList [1..10]) (CL.sourceList [11..12]) C.$$ CL.consume+ res <- runResourceT $ CI.zipSources (CL.sourceList [1..10]) (CL.sourceList [11..12]) C.$$ CL.consume res @=? zip [1..10 :: Int] [11..12 :: Int] describe "zipping sinks" $ do it "take all" $ do- res <- runResourceT $ CL.sourceList [1..10] C.$$ C.zipSinks CL.consume CL.consume+ res <- runResourceT $ CL.sourceList [1..10] C.$$ CI.zipSinks CL.consume CL.consume res @=? ([1..10 :: Int], [1..10 :: Int]) it "take fewer on left" $ do- res <- runResourceT $ CL.sourceList [1..10] C.$$ C.zipSinks (CL.take 4) CL.consume+ res <- runResourceT $ CL.sourceList [1..10] C.$$ CI.zipSinks (CL.take 4) CL.consume res @=? ([1..4 :: Int], [1..10 :: Int]) it "take fewer on right" $ do- res <- runResourceT $ CL.sourceList [1..10] C.$$ C.zipSinks CL.consume (CL.take 4)+ res <- runResourceT $ CL.sourceList [1..10] C.$$ CI.zipSinks CL.consume (CL.take 4) res @=? ([1..10 :: Int], [1..4 :: Int]) describe "Monad instance for Sink" $ do@@ -342,33 +310,6 @@ CL.consume x `shouldBe` [6..10] - describe "lazy" $ do- it' "works inside a ResourceT" $ runResourceT $ do- counter <- liftIO $ I.newIORef 0- let incr i = do- istate <- liftIO $ I.newIORef $ Just (i :: Int)- let loop = do- res <- liftIO $ I.atomicModifyIORef istate ((,) Nothing)- case res of- Nothing -> return ()- Just x -> do- count <- liftIO $ I.atomicModifyIORef counter- (\j -> (j + 1, j + 1))- liftIO $ count `shouldBe` i- C.yield x- loop- loop- nums <- CLazy.lazyConsume $ mconcat $ map incr [1..10]- liftIO $ nums `shouldBe` [1..10]-- it' "returns nothing outside ResourceT" $ do- bss <- runResourceT $ CLazy.lazyConsume $ CB.sourceFile "test/main.hs"- bss `shouldBe` []-- it' "works with pure sources" $ do- nums <- CLazy.lazyConsume $ forever $ C.yield 1- take 100 nums `shouldBe` replicate 100 (1 :: Int)- describe "sequence" $ do it "simple sink" $ do let sumSink = do@@ -404,177 +345,6 @@ return (a, b) (a, b) `shouldBe` (Just 1, [1..10]) - describe "text" $ do- let go enc tenc tdec cenc = describe enc $ do- prop "single chunk" $ \chars -> runST $ runExceptionT_ $ do- let tl = TL.pack chars- lbs = tenc tl- src = CL.sourceList $ L.toChunks lbs- ts <- src C.$= CT.decode cenc C.$$ CL.consume- return $ TL.fromChunks ts == tl- prop "many chunks" $ \chars -> runIdentity $ runExceptionT_ $ do- let tl = TL.pack chars- lbs = tenc tl- src = mconcat $ map (CL.sourceList . return . S.singleton) $ L.unpack lbs-- ts <- src C.$= CT.decode cenc C.$$ CL.consume- return $ TL.fromChunks ts == tl-- -- Check whether raw bytes are decoded correctly, in- -- particular that Text decoding produces an error if- -- and only if Conduit does.- prop "raw bytes" $ \bytes ->- let lbs = L.pack bytes- src = CL.sourceList $ L.toChunks lbs- etl = C.runException $ src C.$= CT.decode cenc C.$$ CL.consume- tl' = tdec lbs- in case etl of- (Left _) -> (return $! TL.toStrict tl') `shouldThrow` anyException- (Right tl) -> TL.fromChunks tl `shouldBe` tl'- prop "encoding" $ \chars -> runIdentity $ runExceptionT_ $ do- let tss = map T.pack chars- lbs = tenc $ TL.fromChunks tss- src = mconcat $ map (CL.sourceList . return) tss- bss <- src C.$= CT.encode cenc C.$$ CL.consume- return $ L.fromChunks bss == lbs- prop "valid then invalid" $ \x y chars -> runIdentity $ runExceptionT_ $ do- let tss = map T.pack ([x, y]:chars)- ts = T.concat tss- lbs = tenc (TL.fromChunks tss) `L.append` "\0\0\0\0\0\0\0"- src = mapM_ C.yield $ L.toChunks lbs- Just x' <- src C.$$ CT.decode cenc C.=$ C.await- return $ x' `T.isPrefixOf` ts- go "utf8" TLE.encodeUtf8 TLE.decodeUtf8 CT.utf8- go "utf16_le" TLE.encodeUtf16LE TLE.decodeUtf16LE CT.utf16_le- go "utf16_be" TLE.encodeUtf16BE TLE.decodeUtf16BE CT.utf16_be- go "utf32_le" TLE.encodeUtf32LE TLE.decodeUtf32LE CT.utf32_le- go "utf32_be" TLE.encodeUtf32BE TLE.decodeUtf32BE CT.utf32_be- it "mixed utf16 and utf8" $ do- let bs = "8\NUL:\NULu\NUL\215\216\217\218"- src = C.yield bs C.$= CT.decode CT.utf16_le- text <- src C.$$ C.await- text `shouldBe` Just "8:u"- (src C.$$ CL.sinkNull) `shouldThrow` anyException- it "invalid utf8" $ do- let bs = S.pack [0..255]- src = C.yield bs C.$= CT.decode CT.utf8- text <- src C.$$ C.await- text `shouldBe` Just (T.pack $ map toEnum [0..127])- (src C.$$ CL.sinkNull) `shouldThrow` anyException- it "catch UTF8 exceptions" $ do- let badBS = "this is good\128\128\0that was bad"-- grabExceptions inner = C.catchC- (inner C.=$= CL.map Right)- (\e -> C.yield (Left (e :: CT.TextException)))-- res <- C.yield badBS C.$$ (,)- <$> (grabExceptions (CT.decode CT.utf8) C.=$ CL.consume)- <*> CL.consume-- first (map (either (Left . show) Right)) res `shouldBe`- ( [ Right "this is good"- , Left $ show $ CT.NewDecodeException "UTF-8" 12 "\128\128\0t"- ]- , ["\128\128\0that was bad"]- )- it "catch UTF8 exceptions, pure" $ do- let badBS = "this is good\128\128\0that was bad"-- grabExceptions inner = do- res <- C.runExceptionC $ inner C.=$= CL.map Right- case res of- Left e -> C.yield $ Left e- Right () -> return ()-- let res = runIdentity $ C.yield badBS C.$$ (,)- <$> (grabExceptions (CT.decode CT.utf8) C.=$ CL.consume)- <*> CL.consume-- first (map (either (Left . show) Right)) res `shouldBe`- ( [ Right "this is good"- , Left $ show $ CT.NewDecodeException "UTF-8" 12 "\128\128\0t"- ]- , ["\128\128\0that was bad"]- )- it "catch UTF8 exceptions, catchExceptionC" $ do- let badBS = "this is good\128\128\0that was bad"-- grabExceptions inner = C.catchExceptionC- (inner C.=$= CL.map Right)- (\e -> C.yield $ Left e)-- let res = C.runException_ $ C.yield badBS C.$$ (,)- <$> (grabExceptions (CT.decode CT.utf8) C.=$ CL.consume)- <*> CL.consume-- first (map (either (Left . show) Right)) res `shouldBe`- ( [ Right "this is good"- , Left $ show $ CT.NewDecodeException "UTF-8" 12 "\128\128\0t"- ]- , ["\128\128\0that was bad"]- )- it "catch UTF8 exceptions, catchExceptionC, decodeUtf8" $ do- let badBS = "this is good\128\128\0that was bad"-- grabExceptions inner = C.catchExceptionC- (inner C.=$= CL.map Right)- (\e -> C.yield $ Left e)-- let res = C.runException_ $ C.yield badBS C.$$ (,)- <$> (grabExceptions CT.decodeUtf8 C.=$ CL.consume)- <*> CL.consume-- first (map (either (Left . show) Right)) res `shouldBe`- ( [ Right "this is good"- , Left $ show $ CT.NewDecodeException "UTF-8" 12 "\128\128\0t"- ]- , ["\128\128\0that was bad"]- )-- describe "text lines" $ do- it "works across split lines" $- (CL.sourceList [T.pack "abc", T.pack "d\nef"] C.$= CT.lines C.$$ CL.consume) ==- [[T.pack "abcd", T.pack "ef"]]- it "works with multiple lines in an item" $- (CL.sourceList [T.pack "ab\ncd\ne"] C.$= CT.lines C.$$ CL.consume) ==- [[T.pack "ab", T.pack "cd", T.pack "e"]]- it "works with ending on a newline" $- (CL.sourceList [T.pack "ab\n"] C.$= CT.lines C.$$ CL.consume) ==- [[T.pack "ab"]]- it "works with ending a middle item on a newline" $- (CL.sourceList [T.pack "ab\n", T.pack "cd\ne"] C.$= CT.lines C.$$ CL.consume) ==- [[T.pack "ab", T.pack "cd", T.pack "e"]]- it "is not too eager" $ do- x <- CL.sourceList ["foobarbaz", error "ignore me"] C.$$ CT.decode CT.utf8 C.=$ CL.head- x `shouldBe` Just "foobarbaz"-- describe "text lines bounded" $ do- it "works across split lines" $- (CL.sourceList [T.pack "abc", T.pack "d\nef"] C.$= CT.linesBounded 80 C.$$ CL.consume) ==- [[T.pack "abcd", T.pack "ef"]]- it "works with multiple lines in an item" $- (CL.sourceList [T.pack "ab\ncd\ne"] C.$= CT.linesBounded 80 C.$$ CL.consume) ==- [[T.pack "ab", T.pack "cd", T.pack "e"]]- it "works with ending on a newline" $- (CL.sourceList [T.pack "ab\n"] C.$= CT.linesBounded 80 C.$$ CL.consume) ==- [[T.pack "ab"]]- it "works with ending a middle item on a newline" $- (CL.sourceList [T.pack "ab\n", T.pack "cd\ne"] C.$= CT.linesBounded 80 C.$$ CL.consume) ==- [[T.pack "ab", T.pack "cd", T.pack "e"]]- it "is not too eager" $ do- x <- CL.sourceList ["foobarbaz", error "ignore me"] C.$$ CT.decode CT.utf8 C.=$ CL.head- x `shouldBe` Just "foobarbaz"- it "throws an exception when lines are too long" $ do- x <- C.runExceptionT $ CL.sourceList ["hello\nworld"] C.$$ CT.linesBounded 4 C.=$ CL.consume- show x `shouldBe` show (Left $ CT.LengthExceeded 4 :: Either CT.TextException ())-- describe "binary isolate" $ do- it "works" $ do- bss <- runResourceT $ CL.sourceList (replicate 1000 "X")- C.$= CB.isolate 6- C.$$ CL.consume- S.concat bss `shouldBe` "XXXXXX" describe "unbuffering" $ do it "works" $ do x <- runResourceT $ do@@ -618,97 +388,6 @@ x `shouldBe` sum [1..10] - describe "properly using binary file reading" $ do- it "sourceFile" $ do- x <- runResourceT $ CB.sourceFile "test/random" C.$$ CL.consume- lbs <- L.readFile "test/random"- L.fromChunks x `shouldBe` lbs-- describe "binary head" $ do- let go lbs = do- x <- CB.head- case (x, L.uncons lbs) of- (Nothing, Nothing) -> return True- (Just y, Just (z, lbs'))- | y == z -> go lbs'- _ -> return False-- prop "works" $ \bss' ->- let bss = map S.pack bss'- in runIdentity $- CL.sourceList bss C.$$ go (L.fromChunks bss)- describe "binary takeWhile" $ do- prop "works" $ \bss' ->- let bss = map S.pack bss'- in runIdentity $ do- bss2 <- CL.sourceList bss C.$$ CB.takeWhile (>= 5) C.=$ CL.consume- return $ L.fromChunks bss2 == L.takeWhile (>= 5) (L.fromChunks bss)- prop "leftovers present" $ \bss' ->- let bss = map S.pack bss'- in runIdentity $ do- result <- CL.sourceList bss C.$$ do- x <- CB.takeWhile (>= 5) C.=$ CL.consume- y <- CL.consume- return (S.concat x, S.concat y)- let expected = S.span (>= 5) $ S.concat bss- if result == expected- then return True- else error $ show (S.concat bss, result, expected)-- describe "binary dropWhile" $ do- prop "works" $ \bss' ->- let bss = map S.pack bss'- in runIdentity $ do- bss2 <- CL.sourceList bss C.$$ do- CB.dropWhile (< 5)- CL.consume- return $ L.fromChunks bss2 == L.dropWhile (< 5) (L.fromChunks bss)-- describe "binary take" $ do- let go n l = CL.sourceList l C.$$ do- a <- CB.take n- b <- CL.consume- return (a, b)-- -- Taking nothing should result in an empty Bytestring- it "nothing" $ do- (a, b) <- runResourceT $ go 0 ["abc", "defg"]- a `shouldBe` L.empty- L.fromChunks b `shouldBe` "abcdefg"-- it "normal" $ do- (a, b) <- runResourceT $ go 4 ["abc", "defg"]- a `shouldBe` "abcd"- L.fromChunks b `shouldBe` "efg"-- -- Taking exactly the data that is available should result in no- -- leftover.- it "all" $ do- (a, b) <- runResourceT $ go 7 ["abc", "defg"]- a `shouldBe` "abcdefg"- b `shouldBe` []-- -- Take as much as possible.- it "more" $ do- (a, b) <- runResourceT $ go 10 ["abc", "defg"]- a `shouldBe` "abcdefg"- b `shouldBe` []-- describe "normalFuseLeft" $ do- it "does not double close conduit" $ do- x <- runResourceT $ do- let src = CL.sourceList ["foobarbazbin"]- src C.$= CB.isolate 10 C.$$ CL.head- x `shouldBe` Just "foobarbazb"-- describe "binary" $ do- prop "lines" $ \bss' -> runIdentity $ do- let bss = map S.pack bss'- bs = S.concat bss- src = CL.sourceList bss- res <- src C.$$ CB.lines C.=$ CL.consume- return $ S8.lines bs == res- describe "termination" $ do it "terminates early" $ do let src = forever $ C.yield ()@@ -982,12 +661,6 @@ x <- runWriterT $ source C.$$ C.transPipe (`evalStateT` 1) replaceNum1 C.=$ CL.consume y <- runWriterT $ source C.$$ C.transPipe (`evalStateT` 1) replaceNum2 C.=$ CL.consume x `shouldBe` y- describe "text decode" $ do- it' "doesn't throw runtime exceptions" $ do- let x = runIdentity $ runExceptionT $ C.yield "\x89\x243" C.$$ CT.decode CT.utf8 C.=$ CL.consume- case x of- Left _ -> return ()- Right t -> error $ "This should have failed: " ++ show t describe "iterM" $ do prop "behavior" $ \l -> monadicIO $ do let counter ref = CL.iterM (const $ liftIO $ M.modifyMVar_ ref (\i -> return $! i + 1))@@ -1022,24 +695,6 @@ res <- C.yield 10 C.$$ C.awaitForever (C.toProducer . src) C.=$ (C.toConsumer sink >>= C.yield) C.=$ C.await res `shouldBe` Just (sum [1..10]) - describe "sinkCacheLength" $ do- it' "works" $ C.runResourceT $ do- lbs <- liftIO $ L.readFile "test/main.hs"- (len, src) <- CB.sourceLbs lbs C.$$ CB.sinkCacheLength- lbs' <- src C.$$ CB.sinkLbs- liftIO $ do- fromIntegral len `shouldBe` L.length lbs- lbs' `shouldBe` lbs- fromIntegral len `shouldBe` L.length lbs'-- describe "Data.Conduit.Binary.mapM_" $ do- prop "telling works" $ \bytes ->- let lbs = L.pack bytes- src = CB.sourceLbs lbs- sink = CB.mapM_ (tell . return . S.singleton)- bss = execWriter $ src C.$$ sink- in L.fromChunks bss == lbs- describe "passthroughSink" $ do it "works" $ do ref <- I.newIORef (-1)@@ -1174,13 +829,13 @@ describe "Data.Conduit.Lift" $ do it "execStateC" $ do- let sink = C.execStateC 0 $ CL.mapM_ $ modify . (+)+ let sink = C.execStateLC 0 $ CL.mapM_ $ modify . (+) src = mapM_ C.yield [1..10 :: Int] res <- src C.$$ sink res `shouldBe` sum [1..10] it "execWriterC" $ do- let sink = C.execWriterC $ CL.mapM_ $ tell . return+ let sink = C.execWriterLC $ CL.mapM_ $ tell . return src = mapM_ C.yield [1..10 :: Int] res <- src C.$$ sink res `shouldBe` [1..10]@@ -1201,34 +856,6 @@ res <- src C.$$ sink res `shouldBe` [1 :: Int] - describe "exception handling" $ do- it "catchC" $ do- ref <- I.newIORef 0- let src = do- C.catchC (CB.sourceFile "some-file-that-does-not-exist") onErr- C.handleC onErr $ CB.sourceFile "conduit.cabal"- onErr :: MonadIO m => IOException -> m ()- onErr _ = liftIO $ I.modifyIORef ref (+ 1)- contents <- L.readFile "conduit.cabal"- res <- C.runResourceT $ src C.$$ CB.sinkLbs- res `shouldBe` contents- errCount <- I.readIORef ref- errCount `shouldBe` (1 :: Int)- it "tryC" $ do- ref <- I.newIORef undefined- let src = do- res1 <- C.tryC $ CB.sourceFile "some-file-that-does-not-exist"- res2 <- C.tryC $ CB.sourceFile "conduit.cabal"- liftIO $ I.writeIORef ref (res1, res2)- contents <- L.readFile "conduit.cabal"- res <- C.runResourceT $ src C.$$ CB.sinkLbs- res `shouldBe` contents- exc <- I.readIORef ref- case exc :: (Either IOException (), Either IOException ()) of- (Left _, Right ()) ->- return ()- _ -> error $ show exc- describe "sequenceSources" $ do it "works" $ do let src1 = mapM_ C.yield [1, 2, 3 :: Int]@@ -1260,7 +887,6 @@ x <- C.runResourceT $ CL.sourceList [100,99..1] C.$$ sink x `shouldBe` (505000 :: Integer) - ES.spec ZipConduit.spec it' :: String -> IO () -> Spec
− test/random
binary file changed (1024 → absent bytes)