diff options
-rw-r--r-- | Pipes/Text.hs | 22 | ||||
-rw-r--r-- | test/Test.hs | 15 |
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 ( | |||
141 | import Control.Exception (throwIO, try) | 141 | import Control.Exception (throwIO, try) |
142 | import Control.Monad (liftM, unless) | 142 | import Control.Monad (liftM, unless) |
143 | import Control.Monad.Trans.State.Strict (StateT(..)) | 143 | import Control.Monad.Trans.State.Strict (StateT(..)) |
144 | import Data.Monoid ((<>)) | ||
144 | import qualified Data.Text as T | 145 | import qualified Data.Text as T |
145 | import qualified Data.Text.IO as T | 146 | import qualified Data.Text.IO as T |
146 | import qualified Data.Text.Encoding as TE | 147 | import 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 | ||
592 | decodeUtf8 :: Monad m => Producer ByteString m r -> Producer Text m (Producer ByteString m r) | 593 | decodeUtf8 :: Monad m => Producer ByteString m r -> Producer Text m (Producer ByteString m r) |
593 | decodeUtf8 = go PE.streamDecodeUtf8 where | 594 | decodeUtf8 = 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 |
605 | splitAt | 607 | splitAt |
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 | |||
23 | import qualified Pipes.Text as TP | 23 | import qualified Pipes.Text as TP |
24 | import qualified Pipes.ByteString as BP | 24 | import qualified Pipes.ByteString as BP |
25 | import qualified Pipes as P | 25 | import qualified Pipes as P |
26 | |||
27 | |||
28 | import Debug.Trace | 26 | import Debug.Trace |
27 | |||
29 | main :: IO () | 28 | main :: IO () |
30 | main = defaultMain [tests] | 29 | main = defaultMain [tests] |
31 | -- >>> :main -a 10000 | 30 | -- >>> :main -a 10000 |
32 | 31 | ||
33 | tests = testGroup "stream_decode" [ | 32 | tests = 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 | ||
38 | t_utf8_incr_valid = do | 37 | t_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 | |||
74 | t_utf8_incr_pipe = do | 70 | t_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 | ||