conduit 1.0.14 → 1.0.15
raw patch · 5 files changed
+137/−26 lines, 5 files
Files
- Data/Conduit.hs +19/−1
- Data/Conduit/Internal.hs +4/−4
- Data/Conduit/Text.hs +96/−20
- conduit.cabal +1/−1
- test/main.hs +17/−0
Data/Conduit.hs view
@@ -79,7 +79,7 @@ import Data.Conduit.Internal hiding (await, awaitForever, yield, yieldOr, leftover, bracketP, addCleanup, transPipe, mapOutput, mapOutputMaybe, mapInput) import qualified Data.Conduit.Internal as CI import Control.Monad.Morph (hoist)-import Control.Monad (liftM, forever)+import Control.Monad (liftM, forever, when, unless) import Control.Applicative (Applicative (..)) import Data.Traversable (Traversable (..)) @@ -145,6 +145,8 @@ -- Since 0.5.0 await :: Monad m => Consumer i m (Maybe i) await = ConduitM CI.await+{-# RULES "await >>= maybe" forall x y. await >>= maybe x y = ConduitM (NeedInput (unConduitM . y) (unConduitM . const x)) #-}+{-# INLINE [1] await #-} -- | Send a value downstream to the next component to consume. If the -- downstream component terminates, this call will never return control. If you@@ -155,7 +157,19 @@ => o -- ^ output value -> ConduitM i o m () yield = ConduitM . CI.yield+{-# INLINE [1] yield #-} +{-# 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+ ; "yieldOr o c >> p" forall o c (p :: ConduitM i o m r). yieldOr o c >> p =+ ConduitM (HaveOutput (unConduitM p) c o)+ ; "when yield next" forall b o p. when b (yield o) >> p =+ 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)+ #-}+ -- | Provide a single piece of leftover input to be consumed by the next -- component in the current monadic binding. --@@ -165,6 +179,9 @@ -- Since 0.5.0 leftover :: i -> ConduitM i o m () leftover = ConduitM . CI.leftover+{-# INLINE [1] leftover #-}+{-# RULES "leftover l >> p" forall l (p :: ConduitM i o m r). leftover l >> p =+ ConduitM (Leftover (unConduitM p) l) #-} -- | Perform some allocation and run an inner component. Two guarantees are -- given about resource finalization:@@ -207,6 +224,7 @@ -> m () -- ^ finalizer -> ConduitM i o m () yieldOr o m = ConduitM $ CI.yieldOr o m+{-# INLINE [1] yieldOr #-} -- | Wait for input forever, calling the given inner component for each piece of -- new input. Returns the upstream result type.
Data/Conduit/Internal.hs view
@@ -307,7 +307,7 @@ -- Since 0.5.0 await :: Pipe l i o u m (Maybe i) await = NeedInput (Done . Just) (\_ -> Done Nothing)-{-# RULES "await >>= maybe" forall x y. await >>= maybe x y = NeedInput y (const x) #-}+{-# RULES "CI.await >>= maybe" forall x y. await >>= maybe x y = NeedInput y (const x) #-} {-# INLINE [1] await #-} -- | This is similar to @await@, but will return the upstream result value as@@ -352,9 +352,9 @@ {-# INLINE [1] yieldOr #-} {-# RULES- "yield o >> p" forall o (p :: Pipe l i o u m r). yield o >> p = HaveOutput p (return ()) o- ; "mapM_ yield" mapM_ yield = sourceList- ; "yieldOr o c >> p" forall o c (p :: Pipe l i o u m r). yieldOr o c >> p = HaveOutput p c o #-}+ "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 #-} -- | Provide a single piece of leftover input to be consumed by the next pipe -- in the current monadic binding.
Data/Conduit/Text.hs view
@@ -29,6 +29,8 @@ , drop , foldLines , withLine+ , decodeUtf8+ , encodeUtf8 ) where import qualified Prelude@@ -153,27 +155,32 @@ decode (NewCodec name _ start) = loop 0 start where- loop consumed dec = await >>= maybe (finish consumed dec) (go consumed dec)-- finish consumed dec =- case dec B.empty of- DecodeResultSuccess _ _ -> return ()- DecodeResultFailure t rest -> onFailure consumed B.empty t rest+ 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 consumed dec bs | B.null bs = loop consumed dec- go consumed dec bs =- case dec bs of- DecodeResultSuccess t dec' -> do- unless (T.null t) (yield t)- let consumed' = consumed + B.length bs- consumed' `seq` loop consumed' dec'- DecodeResultFailure t rest -> onFailure consumed bs t rest+ 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 consumed bs t rest = do- unless (T.null t) (yield t)- unless (B.null rest) (leftover rest)- let consumed' = consumed + B.length bs - B.length rest- monadThrow $ NewDecodeException name consumed' (B.take 4 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@@ -199,7 +206,30 @@ | LengthExceeded Int | TextException Exc.SomeException | NewDecodeException !T.Text !Int !B.ByteString- deriving (Show, Typeable)+ 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 -- |@@ -361,3 +391,49 @@ 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 #-}
conduit.cabal view
@@ -1,5 +1,5 @@ Name: conduit-Version: 1.0.14+Version: 1.0.15 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>.
test/main.hs view
@@ -512,6 +512,23 @@ ] , ["\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" $