aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--Pipes/Text.hs22
-rw-r--r--test/Test.hs15
2 files changed, 17 insertions, 20 deletions
diff --git a/Pipes/Text.hs b/Pipes/Text.hs
index d62aee7..e8b64dc 100644
--- a/Pipes/Text.hs
+++ b/Pipes/Text.hs
@@ -141,6 +141,7 @@ module Pipes.Text (
141import Control.Exception (throwIO, try) 141import Control.Exception (throwIO, try)
142import Control.Monad (liftM, unless) 142import Control.Monad (liftM, unless)
143import Control.Monad.Trans.State.Strict (StateT(..)) 143import Control.Monad.Trans.State.Strict (StateT(..))
144import Data.Monoid ((<>))
144import qualified Data.Text as T 145import qualified Data.Text as T
145import qualified Data.Text.IO as T 146import qualified Data.Text.IO as T
146import qualified Data.Text.Encoding as TE 147import qualified Data.Text.Encoding as TE
@@ -590,16 +591,17 @@ count c p = P.fold (+) 0 id (p >-> P.map (fromIntegral . T.count c))
590-- into a Pipe of Text 591-- into a Pipe of Text
591 592
592decodeUtf8 :: 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)
593decodeUtf8 = go PE.streamDecodeUtf8 where 594decodeUtf8 = go B.empty PE.streamDecodeUtf8 where
594 go dec0 p = do 595 go carry dec0 p = do
595 x <- lift (next p) 596 x <- lift (next p)
596 case x of Left r -> return (return r) 597 case x of Left r -> return (do yield carry
597 Right (chunk, p') -> 598 return r)
598 case dec0 chunk of PE.Some text _ dec -> do yield text 599 Right (chunk, p') -> case dec0 chunk of
599 go dec p' 600 PE.Some text carry2 dec -> do yield text
600 PE.Other text bs -> do yield text 601 go carry2 dec p'
601 return (do yield bs 602 PE.Other text bs -> do yield text
602 p') 603 return (do yield bs
604 p')
603 605
604-- | Splits a 'Producer' after the given number of characters 606-- | Splits a 'Producer' after the given number of characters
605splitAt 607splitAt
diff --git a/test/Test.hs b/test/Test.hs
index 66351d1..53dca6a 100644
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -23,17 +23,16 @@ 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
26
27
28import Debug.Trace 26import Debug.Trace
27
29main :: IO () 28main :: IO ()
30main = defaultMain [tests] 29main = defaultMain [tests]
31-- >>> :main -a 10000 30-- >>> :main -a 10000
32 31
33tests = testGroup "stream_decode" [ 32tests = testGroup "stream_decode" [
34 -- testProperty "t_utf8_incr_valid" t_utf8_incr_valid, 33 -- testProperty "t_utf8_incr_valid" t_utf8_incr_valid,
35 testProperty "t_utf8_incr_mixed" t_utf8_incr_mixed, 34-- testProperty "t_utf8_incr_mixed" t_utf8_incr_mixed ] -- ,
36 testProperty "t_utf8_incr_pipe" t_utf8_incr_pipe] 35 testProperty "t_utf8_incr_pipe" t_utf8_incr_pipe]
37 36
38t_utf8_incr_valid = do 37t_utf8_incr_valid = do
39 Positive n <- arbitrary 38 Positive n <- arbitrary
@@ -68,23 +67,19 @@ t_utf8_incr_mixed = do
68 chunk n bs = let (a,b) = B.splitAt n bs in if B.null a then [] else a : chunk n b 67 chunk n bs = let (a,b) = B.splitAt n bs in if B.null a then [] else a : chunk n b
69 appendBytes txt bts = E.encodeUtf8 txt <> B.pack bts ; (<>) = B.append 68 appendBytes txt bts = E.encodeUtf8 txt <> B.pack bts ; (<>) = B.append
70 69
71
72
73
74t_utf8_incr_pipe = do 70t_utf8_incr_pipe = do
75 Positive m <- arbitrary 71 Positive m <- arbitrary
76 Positive n <- arbitrary 72 Positive n <- arbitrary
77 txt <- genUnicode 73 txt <- genUnicode
78 let chunkSize = mod n 7 + 1 74 let chunkSize = mod n 7 + 1
79 bytesLength = mod 20 m 75 bytesLength = mod 3 m
80 forAll (vector bytesLength) $ 76 forAll (vector bytesLength) $
81 (BL.toStrict . BP.toLazy . roundtrip . P.each . chunk chunkSize . appendBytes txt) 77 (BL.toStrict . BP.toLazy . roundtrip . P.each . chunk chunkSize . appendBytes txt)
82 `eq` 78 `eq`
83 appendBytes txt 79 appendBytes txt
84 where 80 where
85 roundtrip :: Monad m => P.Producer B.ByteString m r -> P.Producer B.ByteString m r 81 roundtrip :: Monad m => P.Producer B.ByteString m r -> P.Producer B.ByteString m r
86 roundtrip p = do pbs <- TP.decodeUtf8 p P.>-> TP.encodeUtf8 82 roundtrip p = join (TP.decodeUtf8 p P.>-> TP.encodeUtf8)
87 pbs
88 chunk n bs = let (a,b) = B.splitAt n bs in if B.null a then [] else a : chunk n b 83 chunk n bs = let (a,b) = B.splitAt n bs in if B.null a then [] else a : chunk n b
89 appendBytes txt bts = E.encodeUtf8 txt <> B.pack bts ; (<>) = B.append 84 appendBytes txt bts = E.encodeUtf8 txt <> B.pack bts ; (<>) = B.append
90 85