From cd4fd5dd5405ad8e324f43ee2bc81822bdece16c Mon Sep 17 00:00:00 2001 From: michaelt Date: Thu, 26 Dec 2013 14:49:51 -0500 Subject: [PATCH] repaired tests, clean encodeUtf8 to return Done r rather than yield B.empty >> Done r when decoding was perfect --- Pipes/Text.hs | 15 +++++++++------ test/Test.hs | 5 ++--- 2 files changed, 11 insertions(+), 9 deletions(-) diff --git a/Pipes/Text.hs b/Pipes/Text.hs index e8b64dc..74d2023 100644 --- a/Pipes/Text.hs +++ b/Pipes/Text.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE RankNTypes, TypeFamilies, NoMonomorphismRestriction #-} +{-# LANGUAGE RankNTypes, TypeFamilies #-} {-| This module provides @pipes@ utilities for \"text streams\", which are streams of 'Text' chunks. The individual chunks are uniformly @strict@, but @@ -587,20 +587,23 @@ count :: (Monad m, Num n) => Text -> Producer Text m () -> m n count c p = P.fold (+) 0 id (p >-> P.map (fromIntegral . T.count c)) {-# INLINABLE count #-} --- | Transform a Pipe of 'ByteString's expected to be UTF-8 encoded --- into a Pipe of Text +-- | Transform a Pipe of 'ByteString's expected to be UTF-8 encoded into a Pipe of Text +-- returning a Pipe of ByteStrings that begins at the point of failure. decodeUtf8 :: Monad m => Producer ByteString m r -> Producer Text m (Producer ByteString m r) decodeUtf8 = go B.empty PE.streamDecodeUtf8 where go carry dec0 p = do x <- lift (next p) - case x of Left r -> return (do yield carry - return r) + case x of Left r -> if B.null carry + then return (return r) -- all input was consumed + else return (do yield carry -- a potentially valid fragment remains + return r) + Right (chunk, p') -> case dec0 chunk of PE.Some text carry2 dec -> do yield text go carry2 dec p' PE.Other text bs -> do yield text - return (do yield bs + return (do yield bs -- an invalid blob remains p') -- | Splits a 'Producer' after the given number of characters diff --git a/test/Test.hs b/test/Test.hs index 53dca6a..f2bf17b 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -23,7 +23,6 @@ import qualified Pipes.Text.Internal as PE import qualified Pipes.Text as TP import qualified Pipes.ByteString as BP import qualified Pipes as P -import Debug.Trace main :: IO () main = defaultMain [tests] @@ -31,7 +30,7 @@ main = defaultMain [tests] tests = testGroup "stream_decode" [ -- testProperty "t_utf8_incr_valid" t_utf8_incr_valid, --- testProperty "t_utf8_incr_mixed" t_utf8_incr_mixed ] -- , + testProperty "t_utf8_incr_mixed" t_utf8_incr_mixed , testProperty "t_utf8_incr_pipe" t_utf8_incr_pipe] t_utf8_incr_valid = do @@ -72,7 +71,7 @@ t_utf8_incr_pipe = do Positive n <- arbitrary txt <- genUnicode let chunkSize = mod n 7 + 1 - bytesLength = mod 3 m + bytesLength = mod 10 m forAll (vector bytesLength) $ (BL.toStrict . BP.toLazy . roundtrip . P.each . chunk chunkSize . appendBytes txt) `eq` -- 2.41.0