aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--Pipes/Text.hs15
-rw-r--r--test/Test.hs5
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 @@
1{-# LANGUAGE RankNTypes, TypeFamilies, NoMonomorphismRestriction #-} 1{-# LANGUAGE RankNTypes, TypeFamilies #-}
2 2
3{-| This module provides @pipes@ utilities for \"text streams\", which are 3{-| This module provides @pipes@ utilities for \"text streams\", which are
4 streams of 'Text' chunks. The individual chunks are uniformly @strict@, but 4 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
587count c p = P.fold (+) 0 id (p >-> P.map (fromIntegral . T.count c)) 587count c p = P.fold (+) 0 id (p >-> P.map (fromIntegral . T.count c))
588{-# INLINABLE count #-} 588{-# INLINABLE count #-}
589 589
590-- | Transform a Pipe of 'ByteString's expected to be UTF-8 encoded 590-- | Transform a Pipe of 'ByteString's expected to be UTF-8 encoded into a Pipe of Text
591-- into a Pipe of Text 591-- returning a Pipe of ByteStrings that begins at the point of failure.
592 592
593decodeUtf8 :: Monad m => Producer ByteString m r -> Producer Text m (Producer ByteString m r) 593decodeUtf8 :: Monad m => Producer ByteString m r -> Producer Text m (Producer ByteString m r)
594decodeUtf8 = go B.empty PE.streamDecodeUtf8 where 594decodeUtf8 = go B.empty PE.streamDecodeUtf8 where
595 go carry dec0 p = do 595 go carry dec0 p = do
596 x <- lift (next p) 596 x <- lift (next p)
597 case x of Left r -> return (do yield carry 597 case x of Left r -> if B.null carry
598 return r) 598 then return (return r) -- all input was consumed
599 else return (do yield carry -- a potentially valid fragment remains
600 return r)
601
599 Right (chunk, p') -> case dec0 chunk of 602 Right (chunk, p') -> case dec0 chunk of
600 PE.Some text carry2 dec -> do yield text 603 PE.Some text carry2 dec -> do yield text
601 go carry2 dec p' 604 go carry2 dec p'
602 PE.Other text bs -> do yield text 605 PE.Other text bs -> do yield text
603 return (do yield bs 606 return (do yield bs -- an invalid blob remains
604 p') 607 p')
605 608
606-- | Splits a 'Producer' after the given number of characters 609-- | 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
23import qualified Pipes.Text as TP 23import qualified Pipes.Text as TP
24import qualified Pipes.ByteString as BP 24import qualified Pipes.ByteString as BP
25import qualified Pipes as P 25import qualified Pipes as P
26import Debug.Trace
27 26
28main :: IO () 27main :: IO ()
29main = defaultMain [tests] 28main = defaultMain [tests]
@@ -31,7 +30,7 @@ main = defaultMain [tests]
31 30
32tests = testGroup "stream_decode" [ 31tests = testGroup "stream_decode" [
33 -- testProperty "t_utf8_incr_valid" t_utf8_incr_valid, 32 -- testProperty "t_utf8_incr_valid" t_utf8_incr_valid,
34-- testProperty "t_utf8_incr_mixed" t_utf8_incr_mixed ] -- , 33 testProperty "t_utf8_incr_mixed" t_utf8_incr_mixed ,
35 testProperty "t_utf8_incr_pipe" t_utf8_incr_pipe] 34 testProperty "t_utf8_incr_pipe" t_utf8_incr_pipe]
36 35
37t_utf8_incr_valid = do 36t_utf8_incr_valid = do
@@ -72,7 +71,7 @@ t_utf8_incr_pipe = do
72 Positive n <- arbitrary 71 Positive n <- arbitrary
73 txt <- genUnicode 72 txt <- genUnicode
74 let chunkSize = mod n 7 + 1 73 let chunkSize = mod n 7 + 1
75 bytesLength = mod 3 m 74 bytesLength = mod 10 m
76 forAll (vector bytesLength) $ 75 forAll (vector bytesLength) $
77 (BL.toStrict . BP.toLazy . roundtrip . P.each . chunk chunkSize . appendBytes txt) 76 (BL.toStrict . BP.toLazy . roundtrip . P.each . chunk chunkSize . appendBytes txt)
78 `eq` 77 `eq`