]>
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 | tests = testGroup "stream_decode" [ | |
31 | -- testProperty "t_utf8_incr_valid" t_utf8_incr_valid, | |
32 | testProperty "t_utf8_incr_mixed" t_utf8_incr_mixed , | |
33 | testProperty "t_utf8_incr_pipe" t_utf8_incr_pipe, | |
34 | testProperty "t_utf8_incr_decoding" t_utf8_incr_decoding, | |
35 | testProperty "t_utf8_dec_some" t_utf8_dec_some] | |
36 | ||
37 | t_utf8_incr_valid = do | |
38 | Positive n <- arbitrary | |
39 | forAll genUnicode $ recode n `eq` id | |
40 | where recode n = T.concat . feedChunksOf n PE.streamDecodeUtf8 . E.encodeUtf8 | |
41 | feedChunksOf :: Int -> (B.ByteString -> PE.Decoding) -> B.ByteString | |
42 | -> [T.Text] | |
43 | feedChunksOf n f bs | |
44 | | B.null bs = [] | |
45 | | otherwise = let (a,b) = B.splitAt n bs | |
46 | PE.Some t _ f' = f a | |
47 | in case f a of | |
48 | PE.Some t _ f' -> t : feedChunksOf n f' b | |
49 | _ -> [] | |
50 | ||
51 | t_utf8_incr_mixed = do | |
52 | Positive n <- arbitrary | |
53 | txt <- genUnicode | |
54 | let chunkSize = mod n 7 + 1 | |
55 | forAll (vector 9) $ | |
56 | (roundtrip . chunk chunkSize . appendBytes txt) `eq` (appendBytes txt) | |
57 | where | |
58 | roundtrip :: [B.ByteString] -> B.ByteString | |
59 | roundtrip bss = go PE.streamDecodeUtf8 B.empty bss where | |
60 | go dec acc [] = acc | |
61 | go dec acc [bs] = case dec bs of | |
62 | PE.Some t l dec' -> acc <> E.encodeUtf8 t <> l | |
63 | PE.Other t bs' -> acc <> E.encodeUtf8 t <> bs' | |
64 | go dec acc (bs:bss) = case dec bs of | |
65 | PE.Some t l dec' -> go dec' (acc <> E.encodeUtf8 t) bss | |
66 | PE.Other t bs' -> acc <> E.encodeUtf8 t <> bs' <> B.concat bss | |
67 | chunk n bs = let (a,b) = B.splitAt n bs in if B.null a then [] else a : chunk n b | |
68 | appendBytes txt bts = E.encodeUtf8 txt <> B.pack bts ; (<>) = B.append | |
69 | ||
70 | t_utf8_incr_pipe = do | |
71 | Positive m <- arbitrary | |
72 | Positive n <- arbitrary | |
73 | txt <- genUnicode | |
74 | let chunkSize = mod n 7 + 1 | |
75 | bytesLength = mod 10 m | |
76 | forAll (vector bytesLength) $ | |
77 | (BL.toStrict . BP.toLazy . roundtrip . P.each . chunk chunkSize . appendBytes txt) | |
78 | `eq` | |
79 | appendBytes txt | |
80 | where | |
81 | roundtrip :: Monad m => P.Producer B.ByteString m r -> P.Producer B.ByteString m r | |
82 | roundtrip p = join (TP.decodeUtf8 p P.>-> TP.encodeUtf8) | |
83 | chunk n bs = let (a,b) = B.splitAt n bs in if B.null a then [] else a : chunk n b | |
84 | appendBytes txt bts = E.encodeUtf8 txt <> B.pack bts ; (<>) = B.append | |
85 | ||
86 | -- | |
87 | t_utf8_incr_decoding = do | |
88 | Positive m <- arbitrary | |
89 | Positive n <- arbitrary | |
90 | txt <- genUnicode | |
91 | let chunkSize = mod n 7 + 1 | |
92 | bytesLength = mod 10 m | |
93 | forAll (vector bytesLength) $ | |
94 | (BL.toStrict . BP.toLazy . roundtrip . P.each . chunk chunkSize . appendBytes txt) | |
95 | `eq` | |
96 | appendBytes txt | |
97 | where | |
98 | roundtrip :: Monad m => P.Producer B.ByteString m r -> P.Producer B.ByteString m r | |
99 | roundtrip p = join (TP.decode utf8_start p P.>-> TP.encodeUtf8) | |
100 | chunk n bs = let (a,b) = B.splitAt n bs in if B.null a then [] else a : chunk n b | |
101 | appendBytes txt bts = E.encodeUtf8 txt <> B.pack bts ; (<>) = B.append | |
102 | utf8_start = PE.Some T.empty B.empty (PE.codecDecode PE.utf8) | |
103 | t_utf8_dec_some = do | |
104 | Positive m <- arbitrary | |
105 | txt <- genUnicode | |
106 | let bytesLength = mod 10 m :: Int | |
107 | forAll (vector bytesLength) $ | |
108 | (roundtrip . appendBytes txt) | |
109 | `eq` | |
110 | appendBytes txt | |
111 | where | |
112 | roundtrip bs = case PE.decodeSomeUtf8 bs of | |
113 | (txt,bys) -> E.encodeUtf8 txt <> bys | |
114 | appendBytes txt bts = E.encodeUtf8 txt <> B.pack bts ; (<>) = B.append | |
115 | ||
116 | ||
117 | ||
118 |