]>
Commit | Line | Data |
---|---|---|
1 | import Utils | |
2 | ||
3 | import Test.QuickCheck | |
4 | import Test.QuickCheck.Monadic | |
5 | import Test.Framework (Test, testGroup, defaultMain) | |
6 | import Test.Framework.Providers.QuickCheck2 (testProperty) | |
7 | ||
8 | import Control.Exception (catch) | |
9 | import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord) | |
10 | import Data.Monoid (Monoid(..)) | |
11 | import Control.Monad | |
12 | import Data.String (fromString) | |
13 | import Data.Text.Encoding.Error | |
14 | import qualified Data.List as L | |
15 | ||
16 | import qualified Data.Bits as Bits (shiftL, shiftR) | |
17 | import qualified Data.ByteString as B | |
18 | import qualified Data.ByteString.Lazy as BL | |
19 | import qualified Data.Text as T | |
20 | import qualified Data.Text.Lazy as TL | |
21 | import qualified Data.Text.Encoding as E | |
22 | import qualified Pipes.Text.Internal as PE | |
23 | import qualified Pipes.Text as TP | |
24 | import qualified Pipes.ByteString as BP | |
25 | import qualified Pipes as P | |
26 | ||
27 | main :: IO () | |
28 | main = defaultMain [tests] | |
29 | -- >>> :main -a 10000 | |
30 | ||
31 | tests = testGroup "stream_decode" [ | |
32 | -- testProperty "t_utf8_incr_valid" t_utf8_incr_valid, | |
33 | testProperty "t_utf8_incr_mixed" t_utf8_incr_mixed , | |
34 | testProperty "t_utf8_incr_pipe" t_utf8_incr_pipe] | |
35 | ||
36 | t_utf8_incr_valid = do | |
37 | Positive n <- arbitrary | |
38 | forAll genUnicode $ recode n `eq` id | |
39 | where recode n = T.concat . feedChunksOf n PE.streamDecodeUtf8 . E.encodeUtf8 | |
40 | feedChunksOf :: Int -> (B.ByteString -> PE.Decoding) -> B.ByteString | |
41 | -> [T.Text] | |
42 | feedChunksOf n f bs | |
43 | | B.null bs = [] | |
44 | | otherwise = let (a,b) = B.splitAt n bs | |
45 | PE.Some t _ f' = f a | |
46 | in case f a of | |
47 | PE.Some t _ f' -> t : feedChunksOf n f' b | |
48 | _ -> [] | |
49 | ||
50 | t_utf8_incr_mixed = do | |
51 | Positive n <- arbitrary | |
52 | txt <- genUnicode | |
53 | let chunkSize = mod n 7 + 1 | |
54 | forAll (vector 9) $ | |
55 | (roundtrip . chunk chunkSize . appendBytes txt) `eq` (appendBytes txt) | |
56 | where | |
57 | roundtrip :: [B.ByteString] -> B.ByteString | |
58 | roundtrip bss = go PE.streamDecodeUtf8 B.empty bss where | |
59 | go dec acc [] = acc | |
60 | go dec acc [bs] = case dec bs of | |
61 | PE.Some t l dec' -> acc <> E.encodeUtf8 t <> l | |
62 | PE.Other t bs' -> acc <> E.encodeUtf8 t <> bs' | |
63 | go dec acc (bs:bss) = case dec bs of | |
64 | PE.Some t l dec' -> go dec' (acc <> E.encodeUtf8 t) bss | |
65 | PE.Other t bs' -> acc <> E.encodeUtf8 t <> bs' <> B.concat bss | |
66 | chunk n bs = let (a,b) = B.splitAt n bs in if B.null a then [] else a : chunk n b | |
67 | appendBytes txt bts = E.encodeUtf8 txt <> B.pack bts ; (<>) = B.append | |
68 | ||
69 | t_utf8_incr_pipe = do | |
70 | Positive m <- arbitrary | |
71 | Positive n <- arbitrary | |
72 | txt <- genUnicode | |
73 | let chunkSize = mod n 7 + 1 | |
74 | bytesLength = mod 10 m | |
75 | forAll (vector bytesLength) $ | |
76 | (BL.toStrict . BP.toLazy . roundtrip . P.each . chunk chunkSize . appendBytes txt) | |
77 | `eq` | |
78 | appendBytes txt | |
79 | where | |
80 | roundtrip :: Monad m => P.Producer B.ByteString m r -> P.Producer B.ByteString m r | |
81 | roundtrip p = join (TP.decodeUtf8 p P.>-> TP.encodeUtf8) | |
82 | chunk n bs = let (a,b) = B.splitAt n bs in if B.null a then [] else a : chunk n b | |
83 | appendBytes txt bts = E.encodeUtf8 txt <> B.pack bts ; (<>) = B.append | |
84 | ||
85 | ||
86 | ||
87 | ||
88 |