tests/Properties.hs · text

git.iko.soy/text

on 0.4 help sign in

text/tests/Properties.hs

862 lines 39 kB history raw

1{-# LANGUAGE BangPatterns, FlexibleInstances, ScopedTypeVariables,

2 TypeSynonymInstances #-}

3{-# OPTIONS_GHC -fno-enable-rewrite-rules #-}

5import Test.QuickCheck

6import Text.Show.Functions ()

8import qualified Data.Bits as Bits (shiftL, shiftR)

9import Data.Char (chr, isLower, isSpace, isUpper, ord)

10import Data.Monoid (Monoid(..))

11import Data.String (fromString)

12import Debug.Trace (trace)

13import Control.Arrow ((***), second)

14import Data.Word (Word8, Word16, Word32)

15import qualified Data.Text as T

16import qualified Data.Text.Lazy as TL

17import qualified Data.Text.Encoding as E

18import Control.Exception (SomeException, try)

19import qualified Data.Text.Fusion as S

20import qualified Data.Text.Fusion.Common as S

21import qualified Data.Text.Lazy.Encoding as EL

22import qualified Data.Text.Lazy.Fusion as SL

23import qualified Data.Text.UnsafeShift as U

24import qualified Data.List as L

25import Prelude hiding (replicate)

26import System.IO.Unsafe (unsafePerformIO)

27import Test.Framework (defaultMain, testGroup)

28import Test.Framework.Providers.QuickCheck (testProperty)

30import QuickCheckUtils (NotEmpty(..))

32-- Ensure that two potentially bottom values (in the sense of crashing

33-- for some inputs, not looping infinitely) either both crash, or both

34-- give comparable results for some input.

35(=^=) :: (Eq a, Show a) => a -> a -> Bool

36{-# NOINLINE (=^=) #-}

37i =^= j = unsafePerformIO $ do

38 x <- try (return $! i)

39 y <- try (return $! j)

40 case (x,y) of

41 (Left (_ :: SomeException), Left (_ :: SomeException))

42 -> return True

43 (Right a, Right b) -> return (a == b)

44 e -> trace ("*** Divergence: " ++ show e) return False

45infix 4 =^=

47t_pack_unpack = (T.unpack . T.pack) `eq` id

48tl_pack_unpack = (TL.unpack . TL.pack) `eq` id

49t_stream_unstream = (S.unstream . S.stream) `eq` id

50tl_stream_unstream = (SL.unstream . SL.stream) `eq` id

51t_reverse_stream t = (S.reverse . S.reverseStream) t == t

52t_singleton c = [c] == (T.unpack . T.singleton) c

53tl_singleton c = [c] == (TL.unpack . TL.singleton) c

54tl_unstreamChunks x = f 11 x == f 1000 x

55 where f n = SL.unstreamChunks n . S.streamList

56tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id

58t_ascii t = E.decodeASCII (E.encodeUtf8 a) == a

59 where a = T.map (\c -> chr (ord c `mod` 128)) t

60t_utf8 = (E.decodeUtf8 . E.encodeUtf8) `eq` id

61tl_utf8 = (EL.decodeUtf8 . EL.encodeUtf8) `eq` id

62t_utf16LE = (E.decodeUtf16LE . E.encodeUtf16LE) `eq` id

63t_utf16BE = (E.decodeUtf16BE . E.encodeUtf16BE) `eq` id

64t_utf32LE = (E.decodeUtf32LE . E.encodeUtf32LE) `eq` id

65t_utf32BE = (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id

67class Stringy s where

68 packS :: String -> s

69 unpackS :: s -> String

70 splitAtS :: Int -> s -> (s,s)

71 packSChunkSize :: Int -> String -> s

72 packSChunkSize _ = packS

74instance Stringy String where

75 packS = id

76 unpackS = id

77 splitAtS = splitAt

79instance Stringy (S.Stream Char) where

80 packS = S.streamList

81 unpackS = S.unstreamList

82 splitAtS n s = (S.take n s, S.drop n s)

84instance Stringy T.Text where

85 packS = T.pack

86 unpackS = T.unpack

87 splitAtS = T.splitAt

89instance Stringy TL.Text where

90 packSChunkSize k = SL.unstreamChunks k . S.streamList

91 packS = TL.pack

92 unpackS = TL.unpack

93 splitAtS = TL.splitAt . fromIntegral

95-- Do two functions give the same answer?

96eq :: (Eq a, Show a) => (t -> a) -> (t -> a) -> t -> Bool

97eq a b s = a s =^= b s

99-- What about with the RHS packed?

100eqP :: (Eq a, Show a, Stringy s) =>

101 (String -> a) -> (s -> a) -> String -> Word8 -> Bool

102eqP f g s w = eql "orig" (f s) (g t) &&

103 eql "mini" (f s) (g mini) &&

104 eql "head" (f sa) (g ta) &&

105 eql "tail" (f sb) (g tb)

106 where t = packS s

107 mini = packSChunkSize 10 s

108 (sa,sb) = splitAt m s

109 (ta,tb) = splitAtS m t

110 l = length s

111 m | l == 0 = n

112 | otherwise = n `mod` l

113 n = fromIntegral w

114 eql d a b | a =^= b = True

115 | otherwise = trace (d ++ ": " ++ show a ++ " /= " ++ show b) False

116

117-- For tests that have O(n^2) running times or input sizes, resize

118-- their inputs to the square root of the originals.

119unsquare :: (Arbitrary a, Show a, Testable b) => (a -> b) -> Property

120unsquare = forAll . sized $ \n -> resize (smaller n) arbitrary

121 where smaller = round . (sqrt :: Double -> Double) . fromIntegral

122

123s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)

124 where _types = s :: String

125sf_Eq p s =

126 ((L.filter p s==) . L.filter p) `eq`

127 (((S.filter p $ S.streamList s)==) . S.filter p . S.streamList)

128t_Eq s = (s==) `eq` ((T.pack s==) . T.pack)

129tl_Eq s = (s==) `eq` ((TL.pack s==) . TL.pack)

130s_Ord s = (compare s) `eq` (compare (S.streamList s) . S.streamList)

131 where _types = s :: String

132sf_Ord p s =

133 ((compare $ L.filter p s) . L.filter p) `eq`

134 (compare (S.filter p $ S.streamList s) . S.filter p . S.streamList)

135t_Ord s = (compare s) `eq` (compare (T.pack s) . T.pack)

136tl_Ord s = (compare s) `eq` (compare (TL.pack s) . TL.pack)

137t_Read = id `eq` (T.unpack . read . show)

138tl_Read = id `eq` (TL.unpack . read . show)

139t_Show = show `eq` (show . T.pack)

140tl_Show = show `eq` (show . TL.pack)

141t_mappend s = mappend s`eqP` (unpackS . mappend (T.pack s))

142tl_mappend s = mappend s`eqP` (unpackS . mappend (TL.pack s))

143t_mconcat = unsquare (mconcat `eq` (unpackS . mconcat . L.map T.pack))

144tl_mconcat = unsquare (mconcat `eq` (unpackS . mconcat . L.map TL.pack))

145t_IsString = fromString `eqP` (T.unpack . fromString)

146tl_IsString = fromString `eqP` (TL.unpack . fromString)

147

148s_cons x = (x:) `eqP` (unpackS . S.cons x)

149sf_cons p x = ((x:) . L.filter p) `eqP` (unpackS . S.cons x . S.filter p)

150t_cons x = (x:) `eqP` (unpackS . T.cons x)

151tl_cons x = (x:) `eqP` (unpackS . TL.cons x)

152s_snoc x = (++ [x]) `eqP` (unpackS . (flip S.snoc) x)

153t_snoc x = (++ [x]) `eqP` (unpackS . (flip T.snoc) x)

154tl_snoc x = (++ [x]) `eqP` (unpackS . (flip TL.snoc) x)

155s_append s = (s++) `eqP` (unpackS . S.append (S.streamList s))

156sf_append p s = (L.filter p s++) `eqP` (unpackS . S.append (S.filter p $ S.streamList s))

157t_append s = (s++) `eqP` (unpackS . T.append (packS s))

158

159uncons (x:xs) = Just (x,xs)

160uncons _ = Nothing

161

162s_uncons = uncons `eqP` (fmap (second unpackS) . S.uncons)

163sf_uncons p = (uncons . L.filter p) `eqP` (fmap (second unpackS) . S.uncons . S.filter p)

164t_uncons = uncons `eqP` (fmap (second unpackS) . T.uncons)

165tl_uncons = uncons `eqP` (fmap (second unpackS) . TL.uncons)

166s_head = head `eqP` S.head

167sf_head p = (head . L.filter p) `eqP` (S.head . S.filter p)

168t_head = head `eqP` T.head

169tl_head = head `eqP` TL.head

170s_last = last `eqP` S.last

171sf_last p = (last . L.filter p) `eqP` (S.last . S.filter p)

172t_last = last `eqP` T.last

173tl_last = last `eqP` TL.last

174s_tail = tail `eqP` (unpackS . S.tail)

175sf_tail p = (tail . L.filter p) `eqP` (unpackS . S.tail . S.filter p)

176t_tail = tail `eqP` (unpackS . T.tail)

177tl_tail = tail `eqP` (unpackS . TL.tail)

178s_init = init `eqP` (unpackS . S.init)

179sf_init p = (init . L.filter p) `eqP` (unpackS . S.init . S.filter p)

180t_init = init `eqP` (unpackS . T.init)

181tl_init = init `eqP` (unpackS . TL.init)

182s_null = null `eqP` S.null

183sf_null p = (null . L.filter p) `eqP` (S.null . S.filter p)

184t_null = null `eqP` T.null

185tl_null = null `eqP` TL.null

186s_length = length `eqP` S.length

187sf_length p = (length . L.filter p) `eqP` (S.length . S.filter p)

188t_length = length `eqP` T.length

189tl_length = length `eqP` (fromIntegral . TL.length)

190

191s_map f = map f `eqP` (unpackS . S.map f)

192sf_map p f = (map f . L.filter p) `eqP` (unpackS . S.map f . S.filter p)

193t_map f = map f `eqP` (unpackS . T.map f)

194tl_map f = map f `eqP` (unpackS . TL.map f)

195t_intercalate c = unsquare (L.intercalate c `eq` (unpackS . T.intercalate (packS c) . map packS))

196tl_intercalate c = unsquare (L.intercalate c `eq` (unpackS . TL.intercalate (TL.pack c) . map TL.pack))

197s_intersperse c = L.intersperse c `eqP` (unpackS . S.intersperse c)

198sf_intersperse p c= (L.intersperse c . L.filter p) `eqP` (unpackS . S.intersperse c . S.filter p)

199t_intersperse c = L.intersperse c `eqP` (unpackS . T.intersperse c)

200tl_intersperse c = L.intersperse c `eqP` (unpackS . TL.intersperse c)

201t_transpose = unsquare (L.transpose `eq` (map unpackS . T.transpose . map packS))

202tl_transpose = unsquare (L.transpose `eq` (map unpackS . TL.transpose . map TL.pack))

203t_reverse = L.reverse `eqP` (unpackS . T.reverse)

204tl_reverse = L.reverse `eqP` (unpackS . TL.reverse)

205t_reverse_short n = L.reverse `eqP` (unpackS . S.reverse . shorten n . S.stream)

206

207t_replace s d = (L.intercalate d . split s) `eqP` (unpackS . T.replace (T.pack s) (T.pack d))

208tl_replace s d = (L.intercalate d . split s) `eqP` (unpackS . TL.replace (TL.pack s) (TL.pack d))

209

210split :: (Eq a) => [a] -> [a] -> [[a]]

211split pat src0

212 | l == 0 = error "empty"

213 | otherwise = go src0

214 where

215 l = length pat

216 go src = search 0 src

217 where

218 search _ [] = [src]

219 search !n s@(_:s')

220 | pat `L.isPrefixOf` s = take n src : go (drop l s)

221 | otherwise = search (n+1) s'

222

223s_toCaseFold_length xs = S.length (S.toCaseFold s) >= length xs

224 where s = S.streamList xs

225sf_toCaseFold_length p xs =

226 (S.length . S.toCaseFold . S.filter p $ s) >= (length . L.filter p $ xs)

227 where s = S.streamList xs

228t_toCaseFold_length t = T.length (T.toCaseFold t) >= T.length t

229tl_toCaseFold_length t = TL.length (TL.toCaseFold t) >= TL.length t

230t_toLower_length t = T.length (T.toLower t) >= T.length t

231t_toLower_lower t = p (T.toLower t) >= p t

232 where p = T.length . T.filter isLower

233tl_toLower_lower t = p (TL.toLower t) >= p t

234 where p = TL.length . TL.filter isLower

235t_toUpper_length t = T.length (T.toUpper t) >= T.length t

236t_toUpper_upper t = p (T.toUpper t) >= p t

237 where p = T.length . T.filter isUpper

238tl_toUpper_upper t = p (TL.toUpper t) >= p t

239 where p = TL.length . TL.filter isUpper

240

241justifyLeft k c s = s ++ L.replicate (k - length s) c

242justifyRight m n s = L.replicate (m - length s) n ++ s

243

244s_justifyLeft k c = justifyLeft k c `eqP` (unpackS . S.justifyLeftI k c)

245sf_justifyLeft p k c =

246 (justifyLeft k c . L.filter p) `eqP` (unpackS . S.justifyLeftI k c . S.filter p)

247t_justifyLeft k c = justifyLeft k c `eqP` (unpackS . T.justifyLeft k c)

248tl_justifyLeft k c = justifyLeft k c `eqP` (unpackS . TL.justifyLeft (fromIntegral k) c)

249t_justifyRight k c = justifyRight k c `eqP` (unpackS . T.justifyRight k c)

250tl_justifyRight k c = justifyRight k c `eqP` (unpackS . TL.justifyRight (fromIntegral k) c)

251

252sf_foldl p f z = (L.foldl f z . L.filter p) `eqP` (S.foldl f z . S.filter p)

253 where _types = f :: Char -> Char -> Char

254t_foldl f z = L.foldl f z `eqP` (T.foldl f z)

255 where _types = f :: Char -> Char -> Char

256tl_foldl f z = L.foldl f z `eqP` (TL.foldl f z)

257 where _types = f :: Char -> Char -> Char

258sf_foldl' p f z = (L.foldl' f z . L.filter p) `eqP` (S.foldl' f z . S.filter p)

259 where _types = f :: Char -> Char -> Char

260t_foldl' f z = L.foldl' f z `eqP` T.foldl' f z

261 where _types = f :: Char -> Char -> Char

262tl_foldl' f z = L.foldl' f z `eqP` TL.foldl' f z

263 where _types = f :: Char -> Char -> Char

264sf_foldl1 p f = (L.foldl1 f . L.filter p) `eqP` (S.foldl1 f . S.filter p)

265t_foldl1 f = L.foldl1 f `eqP` T.foldl1 f

266tl_foldl1 f = L.foldl1 f `eqP` TL.foldl1 f

267sf_foldl1' p f = (L.foldl1' f . L.filter p) `eqP` (S.foldl1' f . S.filter p)

268t_foldl1' f = L.foldl1' f `eqP` T.foldl1' f

269tl_foldl1' f = L.foldl1' f `eqP` TL.foldl1' f

270sf_foldr p f z = (L.foldr f z . L.filter p) `eqP` (S.foldr f z . S.filter p)

271 where _types = f :: Char -> Char -> Char

272t_foldr f z = L.foldr f z `eqP` T.foldr f z

273 where _types = f :: Char -> Char -> Char

274tl_foldr f z = L.foldr f z `eqP` TL.foldr f z

275 where _types = f :: Char -> Char -> Char

276sf_foldr1 p f = (L.foldr1 f . L.filter p) `eqP` (S.foldr1 f . S.filter p)

277t_foldr1 f = L.foldr1 f `eqP` T.foldr1 f

278tl_foldr1 f = L.foldr1 f `eqP` TL.foldr1 f

279

280sf_concat p = unsquare ((L.concat . map (L.filter p)) `eq` (unpackS . S.concat . map (S.filter p . packS)))

281t_concat = unsquare (L.concat `eq` (unpackS . T.concat . map packS))

282tl_concat = unsquare (L.concat `eq` (unpackS . TL.concat . map TL.pack))

283sf_concatMap p f = unsquare ((L.concatMap f . L.filter p) `eqP` (unpackS . S.concatMap (packS . f) . S.filter p))

284t_concatMap f = unsquare (L.concatMap f `eqP` (unpackS . T.concatMap (packS . f)))

285tl_concatMap f = unsquare (L.concatMap f `eqP` (unpackS . TL.concatMap (TL.pack . f)))

286sf_any q p = (L.any p . L.filter q) `eqP` (S.any p . S.filter q)

287t_any p = L.any p `eqP` T.any p

288tl_any p = L.any p `eqP` TL.any p

289sf_all q p = (L.all p . L.filter q) `eqP` (S.all p . S.filter q)

290t_all p = L.all p `eqP` T.all p

291tl_all p = L.all p `eqP` TL.all p

292sf_maximum p = (L.maximum . L.filter p) `eqP` (S.maximum . S.filter p)

293t_maximum = L.maximum `eqP` T.maximum

294tl_maximum = L.maximum `eqP` TL.maximum

295sf_minimum p = (L.minimum . L.filter p) `eqP` (S.minimum . S.filter p)

296t_minimum = L.minimum `eqP` T.minimum

297tl_minimum = L.minimum `eqP` TL.minimum

298

299sf_scanl p f z = (L.scanl f z . L.filter p) `eqP` (unpackS . S.scanl f z . S.filter p)

300t_scanl f z = L.scanl f z `eqP` (unpackS . T.scanl f z)

301tl_scanl f z = L.scanl f z `eqP` (unpackS . TL.scanl f z)

302t_scanl1 f = L.scanl1 f `eqP` (unpackS . T.scanl1 f)

303tl_scanl1 f = L.scanl1 f `eqP` (unpackS . TL.scanl1 f)

304t_scanr f z = L.scanr f z `eqP` (unpackS . T.scanr f z)

305tl_scanr f z = L.scanr f z `eqP` (unpackS . TL.scanr f z)

306t_scanr1 f = L.scanr1 f `eqP` (unpackS . T.scanr1 f)

307tl_scanr1 f = L.scanr1 f `eqP` (unpackS . TL.scanr1 f)

308

309t_mapAccumL f z = unsquare (L.mapAccumL f z `eqP` (second unpackS . T.mapAccumL f z))

310 where _types = f :: Int -> Char -> (Int,Char)

311tl_mapAccumL f z = unsquare (L.mapAccumL f z `eqP` (second unpackS . TL.mapAccumL f z))

312 where _types = f :: Int -> Char -> (Int,Char)

313t_mapAccumR f z = unsquare (L.mapAccumR f z `eqP` (second unpackS . T.mapAccumR f z))

314 where _types = f :: Int -> Char -> (Int,Char)

315tl_mapAccumR f z = unsquare (L.mapAccumR f z `eqP` (second unpackS . TL.mapAccumR f z))

316 where _types = f :: Int -> Char -> (Int,Char)

317

318replicate n l = concat (L.replicate n l)

319

320t_replicate n = replicate n `eq` (unpackS . T.replicate n . packS)

321tl_replicate n = replicate n `eq` (unpackS . TL.replicate (fromIntegral n) . packS)

322t_replicateChar n = L.replicate n `eq` (unpackS . T.replicateChar n)

323tl_replicateChar n= L.replicate n `eq` (unpackS . TL.replicateChar (fromIntegral n))

324

325unf :: Int -> Char -> Maybe (Char, Char)

326unf n c | fromEnum c * 100 > n = Nothing

327 | otherwise = Just (c, succ c)

328

329t_unfoldr n = L.unfoldr (unf n) `eq` (unpackS . T.unfoldr (unf n))

330tl_unfoldr n = L.unfoldr (unf n) `eq` (unpackS . TL.unfoldr (unf n))

331t_unfoldrN n m = (L.take n . L.unfoldr (unf m)) `eq`

332 (unpackS . T.unfoldrN n (unf m))

333tl_unfoldrN n m = (L.take n . L.unfoldr (unf m)) `eq`

334 (unpackS . TL.unfoldrN (fromIntegral n) (unf m))

335

336unpack2 :: (Stringy s) => (s,s) -> (String,String)

337unpack2 = unpackS *** unpackS

338

339s_take n = L.take n `eqP` (unpackS . S.take n)

340sf_take p n = (L.take n . L.filter p) `eqP` (unpackS . S.take n . S.filter p)

341t_take n = L.take n `eqP` (unpackS . T.take n)

342tl_take n = L.take n `eqP` (unpackS . TL.take (fromIntegral n))

343s_drop n = L.drop n `eqP` (unpackS . S.drop n)

344sf_drop p n = (L.drop n . L.filter p) `eqP` (unpackS . S.drop n . S.filter p)

345t_drop n = L.drop n `eqP` (unpackS . T.drop n)

346tl_drop n = L.drop n `eqP` (unpackS . TL.drop (fromIntegral n))

347s_takeWhile p = L.takeWhile p `eqP` (unpackS . S.takeWhile p)

348sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP` (unpackS . S.takeWhile p . S.filter q)

349t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)

350tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)

351s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)

352sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP` (unpackS . S.dropWhile p . S.filter q)

353t_dropWhile p = L.dropWhile p `eqP` (unpackS . T.dropWhile p)

354tl_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)

355t_dropWhileEnd p = (L.reverse . L.dropWhile p . L.reverse) `eqP` (unpackS . T.dropWhileEnd p)

356tl_dropWhileEnd p = (L.reverse . L.dropWhile p . L.reverse) `eqP` (unpackS . TL.dropWhileEnd p)

357t_dropAround p = (L.dropWhile p . L.reverse . L.dropWhile p . L.reverse) `eqP` (unpackS . T.dropAround p)

358tl_dropAround p = (L.dropWhile p . L.reverse . L.dropWhile p . L.reverse) `eqP` (unpackS . TL.dropAround p)

359t_stripStart = T.dropWhile isSpace `eq` T.stripStart

360tl_stripStart = TL.dropWhile isSpace `eq` TL.stripStart

361t_stripEnd = T.dropWhileEnd isSpace `eq` T.stripEnd

362tl_stripEnd = TL.dropWhileEnd isSpace `eq` TL.stripEnd

363t_strip = T.dropAround isSpace `eq` T.strip

364tl_strip = TL.dropAround isSpace `eq` TL.strip

365t_splitAt n = L.splitAt n `eqP` (unpack2 . T.splitAt n)

366tl_splitAt n = L.splitAt n `eqP` (unpack2 . TL.splitAt (fromIntegral n))

367t_span p = L.span p `eqP` (unpack2 . T.span p)

368tl_span p = L.span p `eqP` (unpack2 . TL.span p)

369t_break p = L.break p `eqP` (unpack2 . T.break p)

370tl_break p = L.break p `eqP` (unpack2 . TL.break p)

371t_group = L.group `eqP` (map unpackS . T.group)

372tl_group = L.group `eqP` (map unpackS . TL.group)

373t_groupBy p = L.groupBy p `eqP` (map unpackS . T.groupBy p)

374tl_groupBy p = L.groupBy p `eqP` (map unpackS . TL.groupBy p)

375t_inits = L.inits `eqP` (map unpackS . T.inits)

376tl_inits = L.inits `eqP` (map unpackS . TL.inits)

377t_tails = L.tails `eqP` (map unpackS . T.tails)

378tl_tails = L.tails `eqP` (map unpackS . TL.tails)

379

380t_split_i (NotEmpty t) = id `eq` (T.intercalate t . T.split t)

381tl_split_i (NotEmpty t) = id `eq` (TL.intercalate t . TL.split t)

382t_splitTimes_i k (NotEmpty t) = id `eq` (T.intercalate t . T.splitTimes k t)

383tl_splitTimes_i k (NotEmpty t) = id `eq` (TL.intercalate t . TL.splitTimes k t)

384t_splitTimes_split k (NotEmpty t) =

385 T.splitTimes k t `eq` \u ->

386 case L.splitAt k (T.split t u) of

387 (a,[]) -> a

388 (a,b) -> a ++ [T.intercalate t b]

389tl_splitTimes_split k (NotEmpty t) =

390 TL.splitTimes k t `eq` \u ->

391 case L.splitAt (fromIntegral k) (TL.split t u) of

392 (a,[]) -> a

393 (a,b) -> a ++ [TL.intercalate t b]

394t_splitTimesEnd_i k (NotEmpty t) = id `eq` (T.intercalate t . T.splitTimesEnd k t)

395tl_splitTimesEnd_i k (NotEmpty t) = id `eq` (TL.intercalate t . TL.splitTimesEnd k t)

396t_splitTimesEnd_split (NotEmpty t) = T.splitTimesEnd maxBound t `eq` T.split t

397tl_splitTimesEnd_split (NotEmpty t) = TL.splitTimesEnd maxBound t `eq` TL.split t

398

399t_splitWith p = splitWith p `eqP` (map unpackS . T.splitWith p)

400t_splitWith_count c = (L.length . T.splitWith (==c)) `eq` ((1+) . T.count (T.singleton c))

401t_splitWith_split c = T.splitWith (==c) `eq` T.split (T.singleton c)

402tl_splitWith p = splitWith p `eqP` (map unpackS . TL.splitWith p)

403

404splitWith :: (a -> Bool) -> [a] -> [[a]]

405splitWith _ [] = [[]]

406splitWith p xs = loop xs

407 where loop s | null s' = [l]

408 | otherwise = l : loop (tail s')

409 where (l, s') = break p s

410

411t_chunksOf_same_lengths k = all ((==k) . T.length) . ini . T.chunksOf k

412 where ini [] = []

413 ini xs = init xs

414

415t_chunksOf_length k t = len == T.length t || (k <= 0 && len == 0)

416 where len = L.sum . L.map T.length $ T.chunksOf k t

417

418tl_chunksOf k = T.chunksOf k `eq` (map (T.concat . TL.toChunks) . TL.chunksOf (fromIntegral k) . TL.fromChunks . (:[]))

419

420t_lines = L.lines `eqP` (map unpackS . T.lines)

421tl_lines = L.lines `eqP` (map unpackS . TL.lines)

422{-

423t_lines' = lines' `eqP` (map unpackS . T.lines')

424 where lines' "" = []

425 lines' s = let (l, s') = break eol s

426 in l : case s' of

427 [] -> []

428 ('\r':'\n':s'') -> lines' s''

429 (_:s'') -> lines' s''

430 eol c = c == '\r' || c == '\n'

431-}

432t_words = L.words `eqP` (map unpackS . T.words)

433

434tl_words = L.words `eqP` (map unpackS . TL.words)

435t_unlines = unsquare (L.unlines `eq` (unpackS . T.unlines . map packS))

436tl_unlines = unsquare (L.unlines `eq` (unpackS . TL.unlines . map packS))

437t_unwords = unsquare (L.unwords `eq` (unpackS . T.unwords . map packS))

438tl_unwords = unsquare (L.unwords `eq` (unpackS . TL.unwords . map packS))

439

440s_isPrefixOf s = L.isPrefixOf s `eqP` (S.isPrefixOf (S.stream $ packS s) . S.stream)

441sf_isPrefixOf p s = (L.isPrefixOf s . L.filter p) `eqP` (S.isPrefixOf (S.stream $ packS s) . S.filter p . S.stream)

442t_isPrefixOf s = L.isPrefixOf s`eqP` T.isPrefixOf (packS s)

443tl_isPrefixOf s = L.isPrefixOf s`eqP` TL.isPrefixOf (packS s)

444t_isSuffixOf s = L.isSuffixOf s`eqP` T.isSuffixOf (packS s)

445tl_isSuffixOf s = L.isSuffixOf s`eqP` TL.isSuffixOf (packS s)

446t_isInfixOf s = L.isInfixOf s `eqP` T.isInfixOf (packS s)

447tl_isInfixOf s = L.isInfixOf s `eqP` TL.isInfixOf (packS s)

448

449sf_elem p c = (L.elem c . L.filter p) `eqP` (S.elem c . S.filter p)

450t_elem c = L.elem c `eqP` T.elem c

451tl_elem c = L.elem c `eqP` TL.elem c

452sf_filter q p = (L.filter p . L.filter q) `eqP` (unpackS . S.filter p . S.filter q)

453t_filter p = L.filter p `eqP` (unpackS . T.filter p)

454tl_filter p = L.filter p `eqP` (unpackS . TL.filter p)

455sf_find q p = (L.find p . L.filter q) `eqP` (S.find p . S.filter q)

456t_find p = L.find p `eqP` T.find p

457tl_find p = L.find p `eqP` TL.find p

458t_partition p = L.partition p `eqP` (unpack2 . T.partition p)

459tl_partition p = L.partition p `eqP` (unpack2 . TL.partition p)

460

461sf_index p s = forAll (choose (-l,l*2)) ((L.filter p s L.!!) `eq` S.index (S.filter p $ packS s))

462 where l = L.length s

463t_index s = forAll (choose (-l,l*2)) ((s L.!!) `eq` T.index (packS s))

464 where l = L.length s

465

466tl_index s = forAll (choose (-l,l*2)) ((s L.!!) `eq` (TL.index (packS s) . fromIntegral))

467 where l = L.length s

468

469sf_findIndex q p = (L.findIndex p . L.filter q) `eqP` (S.findIndex p . S.filter q)

470t_findIndex p = L.findIndex p `eqP` T.findIndex p

471tl_findIndex p = (fmap fromIntegral . L.findIndex p) `eqP` TL.findIndex p

472sf_findIndices q p= (L.findIndices p . L.filter q) `eqP` (S.findIndices p . S.filter q)

473t_findIndices p = L.findIndices p `eqP` T.findIndices p

474tl_findIndices p = (fmap fromIntegral . L.findIndices p) `eqP` TL.findIndices p

475sf_elemIndex p c = (L.elemIndex c . L.filter p) `eqP` (S.elemIndex c . S.filter p)

476t_elemIndex c = L.elemIndex c `eqP` T.elemIndex c

477tl_elemIndex c = (fmap fromIntegral . L.elemIndex c) `eqP` TL.elemIndex c

478sf_elemIndices p c= (L.elemIndices c . L.filter p) `eqP` (S.elemIndices c . S.filter p)

479t_elemIndices c = L.elemIndices c`eqP` T.elemIndices c

480tl_elemIndices c = (fmap fromIntegral . L.elemIndices c) `eqP` TL.elemIndices c

481t_count t = (subtract 1 . L.length . T.split t) `eq` T.count t

482tl_count t = (subtract 1 . L.genericLength . TL.split t) `eq` TL.count t

483t_zip s = L.zip s `eqP` T.zip (packS s)

484tl_zip s = L.zip s `eqP` TL.zip (packS s)

485sf_zipWith p c s = (L.zipWith c (L.filter p s) . L.filter p) `eqP` (unpackS . S.zipWith c (S.filter p $ packS s) . S.filter p)

486t_zipWith c s = L.zipWith c s `eqP` (unpackS . T.zipWith c (packS s))

487tl_zipWith c s = L.zipWith c s `eqP` (unpackS . TL.zipWith c (packS s))

488

489-- Bit shifts.

490shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k

491 where width = round (log (fromIntegral m) / log 2 :: Double)

492 (m,_) = (maxBound, m == w)

493shiftR w = forAll (choose (0,width-1)) $ \k -> Bits.shiftR w k == U.shiftR w k

494 where width = round (log (fromIntegral m) / log 2 :: Double)

495 (m,_) = (maxBound, m == w)

496

497shiftL_Int = shiftL :: Int -> Property

498shiftL_Word16 = shiftL :: Word16 -> Property

499shiftL_Word32 = shiftL :: Word32 -> Property

500shiftR_Int = shiftR :: Int -> Property

501shiftR_Word16 = shiftR :: Word16 -> Property

502shiftR_Word32 = shiftR :: Word32 -> Property

503

504-- Regression tests.

505s_filter_eq s = S.filter p t == S.streamList (filter p s)

506 where p = (/= S.last t)

507 t = S.streamList s

508

509-- Make a stream appear shorter than it really is, to ensure that

510-- functions that consume inaccurately sized streams behave

511-- themselves.

512shorten :: Int -> S.Stream a -> S.Stream a

513shorten n t@(S.Stream arr off len)

514 | n < len && n > 0 = S.Stream arr off n

515 | otherwise = t

516

517main = defaultMain tests

518

519tests = [

520 testGroup "creation/elimination" [

521 testProperty "t_pack_unpack" t_pack_unpack,

522 testProperty "tl_pack_unpack" tl_pack_unpack,

523 testProperty "t_stream_unstream" t_stream_unstream,

524 testProperty "tl_stream_unstream" tl_stream_unstream,

525 testProperty "t_reverse_stream" t_reverse_stream,

526 testProperty "t_singleton" t_singleton,

527 testProperty "tl_singleton" tl_singleton,

528 testProperty "tl_unstreamChunks" tl_unstreamChunks,

529 testProperty "tl_chunk_unchunk" tl_chunk_unchunk

530 ],

531

532 testGroup "transcoding" [

533 testProperty "t_ascii" t_ascii,

534 testProperty "t_utf8" t_utf8,

535 testProperty "tl_utf8" tl_utf8,

536 testProperty "t_utf16LE" t_utf16LE,

537 testProperty "t_utf16BE" t_utf16BE,

538 testProperty "t_utf32LE" t_utf32LE,

539 testProperty "t_utf32BE" t_utf32BE

540 ],

541

542 testGroup "instances" [

543 testProperty "s_Eq" s_Eq,

544 testProperty "sf_Eq" sf_Eq,

545 testProperty "t_Eq" t_Eq,

546 testProperty "tl_Eq" tl_Eq,

547 testProperty "s_Ord" s_Ord,

548 testProperty "sf_Ord" sf_Ord,

549 testProperty "t_Ord" t_Ord,

550 testProperty "tl_Ord" tl_Ord,

551 testProperty "t_Read" t_Read,

552 testProperty "tl_Read" tl_Read,

553 testProperty "t_Show" t_Show,

554 testProperty "tl_Show" tl_Show,

555 testProperty "t_mappend" t_mappend,

556 testProperty "tl_mappend" tl_mappend,

557 testProperty "t_mconcat" t_mconcat,

558 testProperty "tl_mconcat" tl_mconcat,

559 testProperty "t_IsString" t_IsString,

560 testProperty "tl_IsString" tl_IsString

561 ],

562

563 testGroup "basics" [

564 testProperty "s_cons" s_cons,

565 testProperty "sf_cons" sf_cons,

566 testProperty "t_cons" t_cons,

567 testProperty "tl_cons" tl_cons,

568 testProperty "s_snoc" s_snoc,

569 testProperty "t_snoc" t_snoc,

570 testProperty "tl_snoc" tl_snoc,

571 testProperty "s_append" s_append,

572 testProperty "sf_append" sf_append,

573 testProperty "t_append" t_append,

574 testProperty "s_uncons" s_uncons,

575 testProperty "sf_uncons" sf_uncons,

576 testProperty "t_uncons" t_uncons,

577 testProperty "tl_uncons" tl_uncons,

578 testProperty "s_head" s_head,

579 testProperty "sf_head" sf_head,

580 testProperty "t_head" t_head,

581 testProperty "tl_head" tl_head,

582 testProperty "s_last" s_last,

583 testProperty "sf_last" sf_last,

584 testProperty "t_last" t_last,

585 testProperty "tl_last" tl_last,

586 testProperty "s_tail" s_tail,

587 testProperty "sf_tail" sf_tail,

588 testProperty "t_tail" t_tail,

589 testProperty "tl_tail" tl_tail,

590 testProperty "s_init" s_init,

591 testProperty "sf_init" sf_init,

592 testProperty "t_init" t_init,

593 testProperty "tl_init" tl_init,

594 testProperty "s_null" s_null,

595 testProperty "sf_null" sf_null,

596 testProperty "t_null" t_null,

597 testProperty "tl_null" tl_null,

598 testProperty "s_length" s_length,

599 testProperty "sf_length" sf_length,

600 testProperty "t_length" t_length,

601 testProperty "tl_length" tl_length

602 ],

603

604 testGroup "transformations" [

605 testProperty "s_map" s_map,

606 testProperty "sf_map" sf_map,

607 testProperty "t_map" t_map,

608 testProperty "tl_map" tl_map,

609 testProperty "t_intercalate" t_intercalate,

610 testProperty "tl_intercalate" tl_intercalate,

611 testProperty "s_intersperse" s_intersperse,

612 testProperty "sf_intersperse" sf_intersperse,

613 testProperty "t_intersperse" t_intersperse,

614 testProperty "tl_intersperse" tl_intersperse,

615 testProperty "t_transpose" t_transpose,

616 testProperty "tl_transpose" tl_transpose,

617 testProperty "t_reverse" t_reverse,

618 testProperty "tl_reverse" tl_reverse,

619 testProperty "t_reverse_short" t_reverse_short,

620 testProperty "t_replace" t_replace,

621 testProperty "tl_replace" tl_replace,

622

623 testGroup "case conversion" [

624 testProperty "s_toCaseFold_length" s_toCaseFold_length,

625 testProperty "sf_toCaseFold_length" sf_toCaseFold_length,

626 testProperty "t_toCaseFold_length" t_toCaseFold_length,

627 testProperty "tl_toCaseFold_length" tl_toCaseFold_length,

628 testProperty "t_toLower_length" t_toLower_length,

629 testProperty "t_toLower_lower" t_toLower_lower,

630 testProperty "tl_toLower_lower" tl_toLower_lower,

631 testProperty "t_toUpper_length" t_toUpper_length,

632 testProperty "t_toUpper_upper" t_toUpper_upper,

633 testProperty "tl_toUpper_upper" tl_toUpper_upper

634 ],

635

636 testGroup "justification" [

637 testProperty "s_justifyLeft" s_justifyLeft,

638 testProperty "sf_justifyLeft" sf_justifyLeft,

639 testProperty "t_justifyLeft" t_justifyLeft,

640 testProperty "tl_justifyLeft" tl_justifyLeft,

641 testProperty "t_justifyRight" t_justifyRight,

642 testProperty "tl_justifyRight" tl_justifyRight

643 ]

644 ],

645

646 testGroup "folds" [

647 testProperty "sf_foldl" sf_foldl,

648 testProperty "t_foldl" t_foldl,

649 testProperty "tl_foldl" tl_foldl,

650 testProperty "sf_foldl'" sf_foldl',

651 testProperty "t_foldl'" t_foldl',

652 testProperty "tl_foldl'" tl_foldl',

653 testProperty "sf_foldl1" sf_foldl1,

654 testProperty "t_foldl1" t_foldl1,

655 testProperty "tl_foldl1" tl_foldl1,

656 testProperty "t_foldl1'" t_foldl1',

657 testProperty "sf_foldl1'" sf_foldl1',

658 testProperty "tl_foldl1'" tl_foldl1',

659 testProperty "sf_foldr" sf_foldr,

660 testProperty "t_foldr" t_foldr,

661 testProperty "tl_foldr" tl_foldr,

662 testProperty "sf_foldr1" sf_foldr1,

663 testProperty "t_foldr1" t_foldr1,

664 testProperty "tl_foldr1" tl_foldr1,

665

666 testGroup "special" [

667 testProperty "sf_concat" sf_concat,

668 testProperty "t_concat" t_concat,

669 testProperty "tl_concat" tl_concat,

670 testProperty "sf_concatMap" sf_concatMap,

671 testProperty "t_concatMap" t_concatMap,

672 testProperty "tl_concatMap" tl_concatMap,

673 testProperty "sf_any" sf_any,

674 testProperty "t_any" t_any,

675 testProperty "tl_any" tl_any,

676 testProperty "sf_all" sf_all,

677 testProperty "t_all" t_all,

678 testProperty "tl_all" tl_all,

679 testProperty "sf_maximum" sf_maximum,

680 testProperty "t_maximum" t_maximum,

681 testProperty "tl_maximum" tl_maximum,

682 testProperty "sf_minimum" sf_minimum,

683 testProperty "t_minimum" t_minimum,

684 testProperty "tl_minimum" tl_minimum

685 ]

686 ],

687

688 testGroup "construction" [

689 testGroup "scans" [

690 testProperty "sf_scanl" sf_scanl,

691 testProperty "t_scanl" t_scanl,

692 testProperty "tl_scanl" tl_scanl,

693 testProperty "t_scanl1" t_scanl1,

694 testProperty "tl_scanl1" tl_scanl1,

695 testProperty "t_scanr" t_scanr,

696 testProperty "tl_scanr" tl_scanr,

697 testProperty "t_scanr1" t_scanr1,

698 testProperty "tl_scanr1" tl_scanr1

699 ],

700

701 testGroup "mapAccum" [

702 testProperty "t_mapAccumL" t_mapAccumL,

703 testProperty "tl_mapAccumL" tl_mapAccumL,

704 testProperty "t_mapAccumR" t_mapAccumR,

705 testProperty "tl_mapAccumR" tl_mapAccumR

706 ],

707

708 testGroup "unfolds" [

709 testProperty "t_replicate" t_replicate,

710 testProperty "tl_replicate" tl_replicate,

711 testProperty "t_replicateChar" t_replicateChar,

712 testProperty "tl_replicateChar" tl_replicateChar,

713 testProperty "t_unfoldr" t_unfoldr,

714 testProperty "tl_unfoldr" tl_unfoldr,

715 testProperty "t_unfoldrN" t_unfoldrN,

716 testProperty "tl_unfoldrN" tl_unfoldrN

717 ]

718 ],

719

720 testGroup "substrings" [

721 testGroup "breaking" [

722 testProperty "s_take" s_take,

723 testProperty "sf_take" sf_take,

724 testProperty "t_take" t_take,

725 testProperty "tl_take" tl_take,

726 testProperty "s_drop" s_drop,

727 testProperty "sf_drop" sf_drop,

728 testProperty "t_drop" t_drop,

729 testProperty "tl_drop" tl_drop,

730 testProperty "s_takeWhile" s_takeWhile,

731 testProperty "sf_takeWhile" sf_takeWhile,

732 testProperty "t_takeWhile" t_takeWhile,

733 testProperty "tl_takeWhile" tl_takeWhile,

734 testProperty "sf_dropWhile" sf_dropWhile,

735 testProperty "s_dropWhile" s_dropWhile,

736 testProperty "t_dropWhile" t_dropWhile,

737 testProperty "tl_dropWhile" tl_dropWhile,

738 testProperty "t_dropWhileEnd" t_dropWhileEnd,

739 testProperty "tl_dropWhileEnd" tl_dropWhileEnd,

740 testProperty "t_dropAround" t_dropAround,

741 testProperty "tl_dropAround" tl_dropAround,

742 testProperty "t_stripStart" t_stripStart,

743 testProperty "tl_stripStart" tl_stripStart,

744 testProperty "t_stripEnd" t_stripEnd,

745 testProperty "tl_stripEnd" tl_stripEnd,

746 testProperty "t_strip" t_strip,

747 testProperty "tl_strip" tl_strip,

748 testProperty "t_splitAt" t_splitAt,

749 testProperty "tl_splitAt" tl_splitAt,

750 testProperty "t_span" t_span,

751 testProperty "tl_span" tl_span,

752 testProperty "t_break" t_break,

753 testProperty "tl_break" tl_break,

754 testProperty "t_group" t_group,

755 testProperty "tl_group" tl_group,

756 testProperty "t_groupBy" t_groupBy,

757 testProperty "tl_groupBy" tl_groupBy,

758 testProperty "t_inits" t_inits,

759 testProperty "tl_inits" tl_inits,

760 testProperty "t_tails" t_tails,

761 testProperty "tl_tails" tl_tails

762 ],

763

764 testGroup "breaking many" [

765 testProperty "t_split_i" t_split_i,

766 testProperty "t_splitTimes_i" t_splitTimes_i,

767 testProperty "tl_splitTimes_i" tl_splitTimes_i,

768 testProperty "t_splitTimes_split" t_splitTimes_split,

769 testProperty "tl_splitTimes_split" tl_splitTimes_split,

770 testProperty "t_splitTimesEnd_i" t_splitTimesEnd_i,

771 testProperty "tl_splitTimesEnd_i" tl_splitTimesEnd_i,

772 testProperty "t_splitTimesEnd_split" t_splitTimesEnd_split,

773 testProperty "tl_splitTimesEnd_split" tl_splitTimesEnd_split,

774 testProperty "tl_split_i" tl_split_i,

775 testProperty "t_splitWith" t_splitWith,

776 testProperty "t_splitWith_count" t_splitWith_count,

777 testProperty "t_splitWith_split" t_splitWith_split,

778 testProperty "tl_splitWith" tl_splitWith,

779 testProperty "t_chunksOf_same_lengths" t_chunksOf_same_lengths,

780 testProperty "t_chunksOf_length" t_chunksOf_length,

781 testProperty "tl_chunksOf" tl_chunksOf

782 ],

783

784 testGroup "lines and words" [

785 testProperty "t_lines" t_lines,

786 testProperty "tl_lines" tl_lines,

787 --testProperty "t_lines'" t_lines',

788 testProperty "t_words" t_words,

789 testProperty "tl_words" tl_words,

790 testProperty "t_unlines" t_unlines,

791 testProperty "tl_unlines" tl_unlines,

792 testProperty "t_unwords" t_unwords,

793 testProperty "tl_unwords" tl_unwords

794 ]

795 ],

796

797 testGroup "predicates" [

798 testProperty "s_isPrefixOf" s_isPrefixOf,

799 testProperty "sf_isPrefixOf" sf_isPrefixOf,

800 testProperty "t_isPrefixOf" t_isPrefixOf,

801 testProperty "tl_isPrefixOf" tl_isPrefixOf,

802 testProperty "t_isSuffixOf" t_isSuffixOf,

803 testProperty "tl_isSuffixOf" tl_isSuffixOf,

804 testProperty "t_isInfixOf" t_isInfixOf,

805 testProperty "tl_isInfixOf" tl_isInfixOf

806 ],

807

808 testGroup "searching" [

809 testProperty "sf_elem" sf_elem,

810 testProperty "t_elem" t_elem,

811 testProperty "tl_elem" tl_elem,

812 testProperty "sf_filter" sf_filter,

813 testProperty "t_filter" t_filter,

814 testProperty "tl_filter" tl_filter,

815 testProperty "sf_find" sf_find,

816 testProperty "t_find" t_find,

817 testProperty "tl_find" tl_find,

818 testProperty "t_partition" t_partition,

819 testProperty "tl_partition" tl_partition

820 ],

821

822 testGroup "indexing" [

823 testProperty "sf_index" sf_index,

824 testProperty "t_index" t_index,

825 testProperty "tl_index" tl_index,

826 testProperty "sf_findIndex" sf_findIndex,

827 testProperty "t_findIndex" t_findIndex,

828 testProperty "tl_findIndex" tl_findIndex,

829 testProperty "sf_findIndices" sf_findIndices,

830 testProperty "t_findIndices" t_findIndices,

831 testProperty "tl_findIndices" tl_findIndices,

832 testProperty "sf_elemIndex" sf_elemIndex,

833 testProperty "t_elemIndex" t_elemIndex,

834 testProperty "tl_elemIndex" tl_elemIndex,

835 testProperty "sf_elemIndices" sf_elemIndices,

836 testProperty "t_elemIndices" t_elemIndices,

837 testProperty "tl_elemIndices" tl_elemIndices,

838 testProperty "t_count" t_count,

839 testProperty "tl_count" tl_count

840 ],

841

842 testGroup "zips" [

843 testProperty "t_zip" t_zip,

844 testProperty "tl_zip" tl_zip,

845 testProperty "sf_zipWith" sf_zipWith,

846 testProperty "t_zipWith" t_zipWith,

847 testProperty "tl_zipWith" tl_zipWith

848 ],

849

850 testGroup "regressions" [

851 testProperty "s_filter_eq" s_filter_eq

852 ],

853

854 testGroup "shifts" [

855 testProperty "shiftL_Int" shiftL_Int,

856 testProperty "shiftL_Word16" shiftL_Word16,

857 testProperty "shiftL_Word32" shiftL_Word32,

858 testProperty "shiftR_Int" shiftR_Int,

859 testProperty "shiftR_Word16" shiftR_Word16,

860 testProperty "shiftR_Word32" shiftR_Word32

861 ]

862 ]