<commit_before>{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -fno-enable-rewrite-rules #-}

import Test.QuickCheck
import Text.Show.Functions

import Data.Char
import Debug.Trace
import Text.Printf
import System.Environment
import Control.Applicative
import Control.Arrow
import Control.Monad
import Data.Word
import qualified Data.ByteString as B
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Encoding as E
import Control.Exception
import qualified Data.Text.Fusion as S
import qualified Data.Text.Fusion.Common as S
import qualified Data.Text.Lazy.Fusion as SL
import qualified Data.List as L
import System.IO.Unsafe
import Prelude hiding (catch)

import QuickCheckUtils

-- If a pure property threatens to crash, wrap it with this to keep
-- QuickCheck from bombing out.
crashy :: a -> a -> a
{-# NOINLINE crashy #-}
crashy onException p = unsafePerformIO $
    (return $! p) `catch` \e ->
    let types = e :: SomeException
    in trace ("*** Exception: " ++ show e) return onException

prop_T_pack_unpack       = (T.unpack . T.pack) `eq` id
prop_TL_pack_unpack      = (TL.unpack . TL.pack) `eq` id
prop_T_stream_unstream   = (S.unstream . S.stream) `eq` id
prop_TL_stream_unstream  = (SL.unstream . SL.stream) `eq` id
prop_T_reverse_stream t  = (S.reverse . S.reverseStream) t == t
prop_T_singleton c       = [c] == (T.unpack . T.singleton) c
prop_TL_singleton c      = [c] == (TL.unpack . TL.singleton) c
prop_TL_unstreamChunks x = f 11 x == f 1000 x
    where f n = SL.unstreamChunks n . S.streamList

prop_T_ascii t           = E.decodeASCII (E.encodeUtf8 a) == a
    where a            = T.map (\c -> chr (ord c `mod` 128)) t
prop_T_utf8              = (E.decodeUtf8 . E.encodeUtf8) `eq` id
prop_T_utf16LE           = (E.decodeUtf16LE . E.encodeUtf16LE) `eq` id
prop_T_utf16BE           = (E.decodeUtf16BE . E.encodeUtf16BE) `eq` id
prop_T_utf32LE           = (E.decodeUtf32LE . E.encodeUtf32LE) `eq` id
prop_T_utf32BE           = (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id

class Target t where
    packT    :: String -> t
    unpackT  :: t -> String
    splitAtT :: Int -> t -> (t,t)
    packTChunkSize :: Int -> String -> t
    packTChunkSize _ = packT

instance Target (S.Stream Char) where
    packT        = S.streamList
    unpackT      = S.unstreamList
    splitAtT n s = (S.take n s, S.drop n s)

instance Target T.Text where
    packT    = T.pack
    unpackT  = T.unpack
    splitAtT = T.splitAt

instance Target TL.Text where
    packTChunkSize k = SL.unstreamChunks k . S.streamList
    packT    = TL.pack
    unpackT  = TL.unpack
    splitAtT = TL.splitAt . fromIntegral

-- Do two functions give the same answer?
eq :: (Eq a) => (t -> a) -> (t -> a) -> t -> Bool
eq a b s  = crashy False $ a s == b s

-- What about with the RHS packed?
eqP :: (Eq a, Show a, Target t) =>
       (String -> a) -> (t -> a) -> String -> Word8 -> Bool
eqP a b s w  = eq "orig" (a s) (b t) &&
               eq "mini" (a s) (b mini) &&
               eq "head" (a sa) (b ta) &&
               eq "tail" (a sb) (b tb)
    where t             = packT s
          mini          = packTChunkSize 10 s
          (sa,sb)       = splitAt m s
          (ta,tb)       = splitAtT m t
          l             = length s
          m | l == 0    = n
            | otherwise = n `mod` l
          n             = fromIntegral w
          eq s a b | crashy False $ a == b = True
                   | otherwise = trace (s ++ ": " ++ show a ++ " /= " ++ show b) False

-- Or with the string non-empty, and the RHS packed?
eqEP :: (Eq a, Target t) =>
        (String -> a) -> (t -> a) -> NotEmpty String -> Word8 -> Bool
eqEP a b e w  = a s == b t &&
                a s == b mini &&
                (null sa || a sa == b ta) &&
                (null sb || a sb == b tb)
    where (sa,sb)       = splitAt m s
          (ta,tb)       = splitAtT m t
          t             = packT s
          mini          = packTChunkSize 10 s
          l             = length s
          m | l == 0    = n
            | otherwise = n `mod` l
          n             = fromIntegral w
          s             = notEmpty e

prop_S_cons x          = (x:)     `eqP` (unpackT . S.cons x)
prop_T_cons x          = (x:)     `eqP` (unpackT . T.cons x)
prop_TL_cons x         = ((x:)     `eqP` (TL.unpack . TL.cons x))
prop_S_snoc x          = (++ [x]) `eqP` (unpackT . (flip S.snoc) x)
prop_T_snoc x          = (++ [x]) `eqP` (unpackT . (flip T.snoc) x)
prop_TL_snoc x         = (++ [x]) `eqP` (unpackT . (flip TL.snoc) x)
prop_T_append s        = (s++)    `eqP` (unpackT . T.append (T.pack s))
prop_T_appendS s       = (s++)    `eqP` (unpackT . S.unstream . S.append (S.stream (T.pack s)) . S.stream)

uncons (x:xs) = Just (x,xs)
uncons _      = Nothing

prop_T_uncons s        = uncons   `eqP` (fmap (second unpackT) . T.uncons)
    where types = s :: String
prop_TL_uncons s       = uncons   `eqP` (fmap (second unpackT) . TL.uncons)
    where types = s :: String
prop_S_head            = head   `eqEP` S.head
prop_T_head            = head   `eqEP` T.head
prop_TL_head           = head   `eqEP` TL.head
prop_S_last            = last   `eqEP` S.last
prop_T_last            = last   `eqEP` T.last
prop_TL_last           = last   `eqEP` TL.last
prop_S_tail            = tail   `eqEP` (unpackT . S.tail)
prop_T_tail            = tail   `eqEP` (unpackT . T.tail)
prop_TL_tail           = tail   `eqEP` (unpackT . TL.tail)
prop_S_init            = init   `eqEP` (unpackT . S.init)
prop_T_init            = init   `eqEP` (unpackT . T.init)
prop_TL_init           = init   `eqEP` (unpackT . TL.init)
prop_S_null            = null   `eqP`  S.null
prop_T_null            = null   `eqP`  T.null
prop_TL_null           = null   `eqP`  TL.null
prop_S_length          = length `eqP`  S.length
prop_T_length          = length `eqP`  T.length
prop_TL_length         = length `eqP`  (fromIntegral . TL.length)
prop_T_map f           = map f  `eqP`  (unpackT . T.map f)
prop_TL_map f          = map f  `eqP`  (unpackT . TL.map f)
prop_T_intercalate c   = L.intercalate c `eq` (unpackT . T.intercalate (T.pack c) . map T.pack)
prop_TL_intercalate c  = L.intercalate c `eq` (unpackT . TL.intercalate (TL.pack c) . map TL.pack)
prop_T_intersperse c   = L.intersperse c `eqP` (unpackT . T.intersperse c)
prop_TL_intersperse c  = L.intersperse c `eqP` (unpackT . TL.intersperse c)
prop_T_transpose       = L.transpose `eq` (map unpackT . T.transpose . map T.pack)
prop_TL_transpose      = L.transpose `eq` (map unpackT . TL.transpose . map TL.pack)
prop_T_reverse         = L.reverse `eqP` (unpackT . T.reverse)
prop_T_reverse_short n = L.reverse `eqP` (unpackT . S.reverse . shorten n . S.stream)

prop_T_foldl f z       = L.foldl f z  `eqP`  (T.foldl f z)
    where types      = f :: Char -> Char -> Char
prop_TL_foldl f z      = L.foldl f z  `eqP`  (TL.foldl f z)
    where types      = f :: Char -> Char -> Char
prop_T_foldl' f z      = L.foldl' f z `eqP`  T.foldl' f z
    where types      = f :: Char -> Char -> Char
prop_TL_foldl' f z     = L.foldl' f z `eqP`  TL.foldl' f z
    where types      = f :: Char -> Char -> Char
prop_T_foldl1 f        = L.foldl1 f   `eqEP` T.foldl1 f
prop_TL_foldl1 f       = L.foldl1 f   `eqEP` TL.foldl1 f
prop_T_foldl1' f       = L.foldl1' f  `eqEP` T.foldl1' f
prop_TL_foldl1' f      = L.foldl1' f  `eqEP` TL.foldl1' f
prop_T_foldr f z       = L.foldr f z  `eqP`  T.foldr f z
    where types      = f :: Char -> Char -> Char
prop_TL_foldr f z      = L.foldr f z  `eqP`  TL.foldr f z
    where types      = f :: Char -> Char -> Char
prop_T_foldr1 f        = L.foldr1 f   `eqEP` T.foldr1 f
prop_TL_foldr1 f       = L.foldr1 f   `eqEP` TL.foldr1 f

prop_T_concat          = L.concat      `eq`   (unpackT . T.concat . map T.pack)
prop_TL_concat         = L.concat      `eq`   (unpackT . TL.concat . map TL.pack)
prop_T_concatMap f     = L.concatMap f `eqP`  (unpackT . T.concatMap (T.pack . f))
prop_TL_concatMap f    = L.concatMap f `eqP`  (unpackT . TL.concatMap (TL.pack . f))
prop_T_any p           = L.any p       `eqP`  T.any p
prop_TL_any p          = L.any p       `eqP`  TL.any p
prop_T_all p           = L.all p       `eqP`  T.all p
prop_TL_all p          = L.all p       `eqP`  TL.all p
prop_T_maximum         = L.maximum     `eqEP` T.maximum
prop_TL_maximum        = L.maximum     `eqEP` TL.maximum
prop_T_minimum         = L.minimum     `eqEP` T.minimum
prop_TL_minimum        = L.minimum     `eqEP` TL.minimum

prop_T_scanl f z       = L.scanl f z   `eqP`  (unpackT . T.scanl f z)
prop_TL_scanl f z      = L.scanl f z   `eqP`  (unpackT . TL.scanl f z)
prop_T_scanl1 f        = L.scanl1 f    `eqP`  (unpackT . T.scanl1 f)
prop_TL_scanl1 f       = L.scanl1 f    `eqP`  (unpackT . TL.scanl1 f)
prop_T_scanr f z       = L.scanr f z   `eqP`  (unpackT . T.scanr f z)
prop_T_scanr1 f        = L.scanr1 f    `eqP`  (unpackT . T.scanr1 f)

prop_T_mapAccumL f z   = L.mapAccumL f z `eqP` (second unpackT . T.mapAccumL f z)
    where types = f :: Int -> Char -> (Int,Char)
prop_TL_mapAccumL f z  = L.mapAccumL f z `eqP` (second unpackT . TL.mapAccumL f z)
    where types = f :: Int -> Char -> (Int,Char)
prop_T_mapAccumR f z   = L.mapAccumR f z `eqP` (second unpackT . T.mapAccumR f z)
    where types = f :: Int -> Char -> (Int,Char)
prop_TL_mapAccumR f z   = L.mapAccumR f z `eqP` (second unpackT . TL.mapAccumR f z)
    where types = f :: Int -> Char -> (Int,Char)

prop_T_replicate n     = L.replicate n `eq` (unpackT . T.replicate n)
prop_TL_replicate n    = L.replicate n `eq` (unpackT . TL.replicate n)

unf :: Int -> Char -> Maybe (Char, Char)
unf n c | fromEnum c * 100 > n = Nothing
        | otherwise            = Just (c, succ c)

prop_T_unfoldr n       = L.unfoldr (unf n) `eq` (unpackT . T.unfoldr (unf n))
prop_TL_unfoldr n      = L.unfoldr (unf n) `eq` (unpackT . TL.unfoldr (unf n))
prop_T_unfoldrN n m    = (L.take n . L.unfoldr (unf m)) `eq`
                         (unpackT . T.unfoldrN n (unf m))
prop_TL_unfoldrN n m   = (L.take n . L.unfoldr (unf m)) `eq`
                         (unpackT . TL.unfoldrN (fromIntegral n) (unf m))

unpack2 :: (Target t) => (t,t) -> (String,String)
unpack2 = unpackT *** unpackT

prop_S_take n          = L.take n      `eqP` (unpackT . S.take n)
prop_T_take n          = L.take n      `eqP` (unpackT . T.take n)
prop_TL_take n         = L.take n      `eqP` (unpackT . TL.take (fromIntegral n))
prop_S_drop n          = L.drop n      `eqP` (unpackT . S.drop n)
prop_T_drop n          = L.drop n      `eqP` (unpackT . T.drop n)
prop_TL_drop n         = L.drop n      `eqP` (unpackT . TL.drop n)
prop_S_takeWhile p     = L.takeWhile p `eqP` (unpackT . S.takeWhile p)
prop_T_takeWhile p     = L.takeWhile p `eqP` (unpackT . T.takeWhile p)
prop_TL_takeWhile p    = L.takeWhile p `eqP` (unpackT . TL.takeWhile p)
prop_S_dropWhile p     = L.dropWhile p `eqP` (unpackT . S.dropWhile p)
prop_T_dropWhile p     = L.dropWhile p `eqP` (unpackT . T.dropWhile p)
prop_TL_dropWhile p    = L.dropWhile p `eqP` (unpackT . S.dropWhile p)
prop_T_splitAt n       = L.splitAt n   `eqP` (unpack2 . T.splitAt n)
prop_TL_splitAt n      = L.splitAt n   `eqP` (unpack2 . TL.splitAt (fromIntegral n))
prop_T_span p          = L.span p      `eqP` (unpack2 . T.span p)
prop_TL_span p         = L.span p      `eqP` (unpack2 . TL.span p)
prop_T_break p         = L.break p     `eqP` (unpack2 . T.break p)
prop_TL_break p        = L.break p     `eqP` (unpack2 . TL.break p)
prop_T_group           = L.group       `eqP` (map unpackT . T.group)
prop_TL_group          = L.group       `eqP` (map unpackT . TL.group)
prop_T_groupBy p       = L.groupBy p   `eqP` (map unpackT . T.groupBy p)
prop_TL_groupBy p      = L.groupBy p   `eqP` (map unpackT . TL.groupBy p)
prop_T_inits           = L.inits       `eqP` (map unpackT . T.inits)
prop_TL_inits          = L.inits       `eqP` (map unpackT . TL.inits)
prop_T_tails           = L.tails       `eqP` (map unpackT . T.tails)
prop_TL_tails          = L.tails       `eqP` (map unpackT . TL.tails)

prop_T_split_i c       = id `eq` (T.intercalate (T.singleton c) . T.split c)
prop_TL_split_i c      = id `eq` (TL.intercalate (TL.singleton c) . TL.split c)

prop_T_splitWith p     = splitWith p `eqP` (map unpackT . T.splitWith p)
prop_TL_splitWith p    = splitWith p `eqP` (map unpackT . TL.splitWith p)

splitWith :: (a -> Bool) -> [a] -> [[a]]
splitWith _ [] =  []
splitWith p xs = loop xs
    where loop s | null s'   = [l]
                 | otherwise = l : loop (tail s')
              where (l, s') = break p s

prop_T_breakSubstring_isInfixOf s l
                     = T.isInfixOf s l ==
                       T.null s || (not . T.null . snd $ T.breakSubstring s l)
prop_T_breakSubstringC c
                     = L.break (==c) `eqP`
                       (unpack2 . T.breakSubstring (T.singleton c))

prop_T_lines           = L.lines       `eqP` (map unpackT . T.lines)
{-
prop_T_lines'          = lines'        `eqP` (map unpackT . T.lines')
    where lines' "" =  []
          lines' s =  let (l, s') = break eol s
                      in  l : case s' of
                                []      -> []
                                ('\r':'\n':s'') -> lines' s''
                                (_:s'') -> lines' s''
          eol c = c == '\r' || c == '\n'
-}
prop_T_words           = L.words       `eqP` (map unpackT . T.words)
prop_T_unlines         = L.unlines     `eq`  (unpackT . T.unlines . map T.pack)
prop_T_unwords         = L.unwords     `eq`  (unpackT . T.unwords . map T.pack)

prop_T_isPrefixOf s    = L.isPrefixOf s`eqP` T.isPrefixOf (T.pack s)
prop_T_isPrefixOfS s   = L.isPrefixOf s`eqP` (S.isPrefixOf (S.stream $ T.pack s) . S.stream)
prop_T_isSuffixOf s    = L.isSuffixOf s`eqP` T.isSuffixOf (T.pack s)
prop_T_isInfixOf s     = L.isInfixOf s `eqP` T.isInfixOf (T.pack s)

prop_T_elem c          = L.elem c      `eqP` T.elem c
prop_T_filter p        = L.filter p    `eqP` (unpackT . T.filter p)
prop_T_find p          = L.find p      `eqP` T.find p
prop_T_partition p     = L.partition p `eqP` (unpack2 . T.partition p)

prop_T_index x s       = x < L.length s && x >= 0 ==>
                       (L.!!) s x == T.index (T.pack s) x
prop_T_findIndex p     = L.findIndex p `eqP` T.findIndex p
prop_T_findIndices p   = L.findIndices p`eqP` T.findIndices p
prop_T_elemIndex c     = L.elemIndex c `eqP` T.elemIndex c
prop_T_elemIndices c   = L.elemIndices c`eqP` T.elemIndices c
prop_T_count c         = (L.length . L.elemIndices c) `eqP` T.count c
prop_T_zipWith c s     = L.zipWith c s `eqP` (unpackT . T.zipWith c (T.pack s))

-- Regression tests.
prop_S_filter_eq s = S.filter p t == S.streamList (filter p s)
    where p = (/= S.last t)
          t = S.streamList s

-- Make a stream appear shorter than it really is, to ensure that
-- functions that consume inaccurately sized streams behave
-- themselves.
shorten :: Int -> S.Stream a -> S.Stream a
shorten n t@(S.Stream arr off len)
    | n < len && n > 0 = S.Stream arr off n
    | otherwise        = t

main = run tests =<< getArgs

run :: [(String, Int -> IO (Bool,Int))] -> [String] -> IO ()
run tests args = do
  let n = case args of
            [s] -> read s
            []  -> 100
            _   -> error "too many arguments"
  (results,passed) <- unzip <$> mapM (\(s,a) -> printf "%-40s: " s >> a n) tests
  printf "Passed %d tests!\n" (sum passed)
  when (not . and $ results) $
      fail "Not all tests passed!"

tests :: [(String, Int -> IO (Bool, Int))]
tests = [
  ("prop_T_pack_unpack", mytest prop_T_pack_unpack),
  ("prop_TL_pack_unpack", mytest prop_TL_pack_unpack),
  ("prop_T_stream_unstream", mytest prop_T_stream_unstream),
  ("prop_TL_stream_unstream", mytest prop_TL_stream_unstream),
  ("prop_T_reverse_stream", mytest prop_T_reverse_stream),
  ("prop_T_singleton", mytest prop_T_singleton),
  ("prop_TL_singleton", mytest prop_TL_singleton),
  ("prop_TL_unstreamChunks", mytest prop_TL_unstreamChunks),

  ("prop_T_ascii", mytest prop_T_ascii),
  ("prop_T_utf8", mytest prop_T_utf8),<commit_msg>Test fromChunks and toChunks on lazy Text<commit_after>{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -fno-enable-rewrite-rules #-}

import Test.QuickCheck
import Text.Show.Functions

import Data.Char
import Debug.Trace
import Text.Printf
import System.Environment
import Control.Applicative
import Control.Arrow
import Control.Monad
import Data.Word
import qualified Data.ByteString as B
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Encoding as E
import Control.Exception
import qualified Data.Text.Fusion as S
import qualified Data.Text.Fusion.Common as S
import qualified Data.Text.Lazy.Fusion as SL
import qualified Data.List as L
import System.IO.Unsafe
import Prelude hiding (catch)

import QuickCheckUtils

-- If a pure property threatens to crash, wrap it with this to keep
-- QuickCheck from bombing out.
crashy :: a -> a -> a
{-# NOINLINE crashy #-}
crashy onException p = unsafePerformIO $
    (return $! p) `catch` \e ->
    let types = e :: SomeException
    in trace ("*** Exception: " ++ show e) return onException

prop_T_pack_unpack       = (T.unpack . T.pack) `eq` id
prop_TL_pack_unpack      = (TL.unpack . TL.pack) `eq` id
prop_T_stream_unstream   = (S.unstream . S.stream) `eq` id
prop_TL_stream_unstream  = (SL.unstream . SL.stream) `eq` id
prop_T_reverse_stream t  = (S.reverse . S.reverseStream) t == t
prop_T_singleton c       = [c] == (T.unpack . T.singleton) c
prop_TL_singleton c      = [c] == (TL.unpack . TL.singleton) c
prop_TL_unstreamChunks x = f 11 x == f 1000 x
    where f n = SL.unstreamChunks n . S.streamList
prop_TL_chunk_unchunk    = (TL.fromChunks . TL.toChunks) `eq` id

prop_T_ascii t           = E.decodeASCII (E.encodeUtf8 a) == a
    where a            = T.map (\c -> chr (ord c `mod` 128)) t
prop_T_utf8              = (E.decodeUtf8 . E.encodeUtf8) `eq` id
prop_T_utf16LE           = (E.decodeUtf16LE . E.encodeUtf16LE) `eq` id
prop_T_utf16BE           = (E.decodeUtf16BE . E.encodeUtf16BE) `eq` id
prop_T_utf32LE           = (E.decodeUtf32LE . E.encodeUtf32LE) `eq` id
prop_T_utf32BE           = (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id

class Target t where
    packT    :: String -> t
    unpackT  :: t -> String
    splitAtT :: Int -> t -> (t,t)
    packTChunkSize :: Int -> String -> t
    packTChunkSize _ = packT

instance Target (S.Stream Char) where
    packT        = S.streamList
    unpackT      = S.unstreamList
    splitAtT n s = (S.take n s, S.drop n s)

instance Target T.Text where
    packT    = T.pack
    unpackT  = T.unpack
    splitAtT = T.splitAt

instance Target TL.Text where
    packTChunkSize k = SL.unstreamChunks k . S.streamList
    packT    = TL.pack
    unpackT  = TL.unpack
    splitAtT = TL.splitAt . fromIntegral

-- Do two functions give the same answer?
eq :: (Eq a) => (t -> a) -> (t -> a) -> t -> Bool
eq a b s  = crashy False $ a s == b s

-- What about with the RHS packed?
eqP :: (Eq a, Show a, Target t) =>
       (String -> a) -> (t -> a) -> String -> Word8 -> Bool
eqP a b s w  = eq "orig" (a s) (b t) &&
               eq "mini" (a s) (b mini) &&
               eq "head" (a sa) (b ta) &&
               eq "tail" (a sb) (b tb)
    where t             = packT s
          mini          = packTChunkSize 10 s
          (sa,sb)       = splitAt m s
          (ta,tb)       = splitAtT m t
          l             = length s
          m | l == 0    = n
            | otherwise = n `mod` l
          n             = fromIntegral w
          eq s a b | crashy False $ a == b = True
                   | otherwise = trace (s ++ ": " ++ show a ++ " /= " ++ show b) False

-- Or with the string non-empty, and the RHS packed?
eqEP :: (Eq a, Target t) =>
        (String -> a) -> (t -> a) -> NotEmpty String -> Word8 -> Bool
eqEP a b e w  = a s == b t &&
                a s == b mini &&
                (null sa || a sa == b ta) &&
                (null sb || a sb == b tb)
    where (sa,sb)       = splitAt m s
          (ta,tb)       = splitAtT m t
          t             = packT s
          mini          = packTChunkSize 10 s
          l             = length s
          m | l == 0    = n
            | otherwise = n `mod` l
          n             = fromIntegral w
          s             = notEmpty e

prop_S_cons x          = (x:)     `eqP` (unpackT . S.cons x)
prop_T_cons x          = (x:)     `eqP` (unpackT . T.cons x)
prop_TL_cons x         = ((x:)     `eqP` (TL.unpack . TL.cons x))
prop_S_snoc x          = (++ [x]) `eqP` (unpackT . (flip S.snoc) x)
prop_T_snoc x          = (++ [x]) `eqP` (unpackT . (flip T.snoc) x)
prop_TL_snoc x         = (++ [x]) `eqP` (unpackT . (flip TL.snoc) x)
prop_T_append s        = (s++)    `eqP` (unpackT . T.append (T.pack s))
prop_T_appendS s       = (s++)    `eqP` (unpackT . S.unstream . S.append (S.stream (T.pack s)) . S.stream)

uncons (x:xs) = Just (x,xs)
uncons _      = Nothing

prop_T_uncons s        = uncons   `eqP` (fmap (second unpackT) . T.uncons)
    where types = s :: String
prop_TL_uncons s       = uncons   `eqP` (fmap (second unpackT) . TL.uncons)
    where types = s :: String
prop_S_head            = head   `eqEP` S.head
prop_T_head            = head   `eqEP` T.head
prop_TL_head           = head   `eqEP` TL.head
prop_S_last            = last   `eqEP` S.last
prop_T_last            = last   `eqEP` T.last
prop_TL_last           = last   `eqEP` TL.last
prop_S_tail            = tail   `eqEP` (unpackT . S.tail)
prop_T_tail            = tail   `eqEP` (unpackT . T.tail)
prop_TL_tail           = tail   `eqEP` (unpackT . TL.tail)
prop_S_init            = init   `eqEP` (unpackT . S.init)
prop_T_init            = init   `eqEP` (unpackT . T.init)
prop_TL_init           = init   `eqEP` (unpackT . TL.init)
prop_S_null            = null   `eqP`  S.null
prop_T_null            = null   `eqP`  T.null
prop_TL_null           = null   `eqP`  TL.null
prop_S_length          = length `eqP`  S.length
prop_T_length          = length `eqP`  T.length
prop_TL_length         = length `eqP`  (fromIntegral . TL.length)
prop_T_map f           = map f  `eqP`  (unpackT . T.map f)
prop_TL_map f          = map f  `eqP`  (unpackT . TL.map f)
prop_T_intercalate c   = L.intercalate c `eq` (unpackT . T.intercalate (T.pack c) . map T.pack)
prop_TL_intercalate c  = L.intercalate c `eq` (unpackT . TL.intercalate (TL.pack c) . map TL.pack)
prop_T_intersperse c   = L.intersperse c `eqP` (unpackT . T.intersperse c)
prop_TL_intersperse c  = L.intersperse c `eqP` (unpackT . TL.intersperse c)
prop_T_transpose       = L.transpose `eq` (map unpackT . T.transpose . map T.pack)
prop_TL_transpose      = L.transpose `eq` (map unpackT . TL.transpose . map TL.pack)
prop_T_reverse         = L.reverse `eqP` (unpackT . T.reverse)
prop_T_reverse_short n = L.reverse `eqP` (unpackT . S.reverse . shorten n . S.stream)

prop_T_foldl f z       = L.foldl f z  `eqP`  (T.foldl f z)
    where types      = f :: Char -> Char -> Char
prop_TL_foldl f z      = L.foldl f z  `eqP`  (TL.foldl f z)
    where types      = f :: Char -> Char -> Char
prop_T_foldl' f z      = L.foldl' f z `eqP`  T.foldl' f z
    where types      = f :: Char -> Char -> Char
prop_TL_foldl' f z     = L.foldl' f z `eqP`  TL.foldl' f z
    where types      = f :: Char -> Char -> Char
prop_T_foldl1 f        = L.foldl1 f   `eqEP` T.foldl1 f
prop_TL_foldl1 f       = L.foldl1 f   `eqEP` TL.foldl1 f
prop_T_foldl1' f       = L.foldl1' f  `eqEP` T.foldl1' f
prop_TL_foldl1' f      = L.foldl1' f  `eqEP` TL.foldl1' f
prop_T_foldr f z       = L.foldr f z  `eqP`  T.foldr f z
    where types      = f :: Char -> Char -> Char
prop_TL_foldr f z      = L.foldr f z  `eqP`  TL.foldr f z
    where types      = f :: Char -> Char -> Char
prop_T_foldr1 f        = L.foldr1 f   `eqEP` T.foldr1 f
prop_TL_foldr1 f       = L.foldr1 f   `eqEP` TL.foldr1 f

prop_T_concat          = L.concat      `eq`   (unpackT . T.concat . map T.pack)
prop_TL_concat         = L.concat      `eq`   (unpackT . TL.concat . map TL.pack)
prop_T_concatMap f     = L.concatMap f `eqP`  (unpackT . T.concatMap (T.pack . f))
prop_TL_concatMap f    = L.concatMap f `eqP`  (unpackT . TL.concatMap (TL.pack . f))
prop_T_any p           = L.any p       `eqP`  T.any p
prop_TL_any p          = L.any p       `eqP`  TL.any p
prop_T_all p           = L.all p       `eqP`  T.all p
prop_TL_all p          = L.all p       `eqP`  TL.all p
prop_T_maximum         = L.maximum     `eqEP` T.maximum
prop_TL_maximum        = L.maximum     `eqEP` TL.maximum
prop_T_minimum         = L.minimum     `eqEP` T.minimum
prop_TL_minimum        = L.minimum     `eqEP` TL.minimum

prop_T_scanl f z       = L.scanl f z   `eqP`  (unpackT . T.scanl f z)
prop_TL_scanl f z      = L.scanl f z   `eqP`  (unpackT . TL.scanl f z)
prop_T_scanl1 f        = L.scanl1 f    `eqP`  (unpackT . T.scanl1 f)
prop_TL_scanl1 f       = L.scanl1 f    `eqP`  (unpackT . TL.scanl1 f)
prop_T_scanr f z       = L.scanr f z   `eqP`  (unpackT . T.scanr f z)
prop_T_scanr1 f        = L.scanr1 f    `eqP`  (unpackT . T.scanr1 f)

prop_T_mapAccumL f z   = L.mapAccumL f z `eqP` (second unpackT . T.mapAccumL f z)
    where types = f :: Int -> Char -> (Int,Char)
prop_TL_mapAccumL f z  = L.mapAccumL f z `eqP` (second unpackT . TL.mapAccumL f z)
    where types = f :: Int -> Char -> (Int,Char)
prop_T_mapAccumR f z   = L.mapAccumR f z `eqP` (second unpackT . T.mapAccumR f z)
    where types = f :: Int -> Char -> (Int,Char)
prop_TL_mapAccumR f z   = L.mapAccumR f z `eqP` (second unpackT . TL.mapAccumR f z)
    where types = f :: Int -> Char -> (Int,Char)

prop_T_replicate n     = L.replicate n `eq` (unpackT . T.replicate n)
prop_TL_replicate n    = L.replicate n `eq` (unpackT . TL.replicate n)

unf :: Int -> Char -> Maybe (Char, Char)
unf n c | fromEnum c * 100 > n = Nothing
        | otherwise            = Just (c, succ c)

prop_T_unfoldr n       = L.unfoldr (unf n) `eq` (unpackT . T.unfoldr (unf n))
prop_TL_unfoldr n      = L.unfoldr (unf n) `eq` (unpackT . TL.unfoldr (unf n))
prop_T_unfoldrN n m    = (L.take n . L.unfoldr (unf m)) `eq`
                         (unpackT . T.unfoldrN n (unf m))
prop_TL_unfoldrN n m   = (L.take n . L.unfoldr (unf m)) `eq`
                         (unpackT . TL.unfoldrN (fromIntegral n) (unf m))

unpack2 :: (Target t) => (t,t) -> (String,String)
unpack2 = unpackT *** unpackT

prop_S_take n          = L.take n      `eqP` (unpackT . S.take n)
prop_T_take n          = L.take n      `eqP` (unpackT . T.take n)
prop_TL_take n         = L.take n      `eqP` (unpackT . TL.take (fromIntegral n))
prop_S_drop n          = L.drop n      `eqP` (unpackT . S.drop n)
prop_T_drop n          = L.drop n      `eqP` (unpackT . T.drop n)
prop_TL_drop n         = L.drop n      `eqP` (unpackT . TL.drop n)
prop_S_takeWhile p     = L.takeWhile p `eqP` (unpackT . S.takeWhile p)
prop_T_takeWhile p     = L.takeWhile p `eqP` (unpackT . T.takeWhile p)
prop_TL_takeWhile p    = L.takeWhile p `eqP` (unpackT . TL.takeWhile p)
prop_S_dropWhile p     = L.dropWhile p `eqP` (unpackT . S.dropWhile p)
prop_T_dropWhile p     = L.dropWhile p `eqP` (unpackT . T.dropWhile p)
prop_TL_dropWhile p    = L.dropWhile p `eqP` (unpackT . S.dropWhile p)
prop_T_splitAt n       = L.splitAt n   `eqP` (unpack2 . T.splitAt n)
prop_TL_splitAt n      = L.splitAt n   `eqP` (unpack2 . TL.splitAt (fromIntegral n))
prop_T_span p          = L.span p      `eqP` (unpack2 . T.span p)
prop_TL_span p         = L.span p      `eqP` (unpack2 . TL.span p)
prop_T_break p         = L.break p     `eqP` (unpack2 . T.break p)
prop_TL_break p        = L.break p     `eqP` (unpack2 . TL.break p)
prop_T_group           = L.group       `eqP` (map unpackT . T.group)
prop_TL_group          = L.group       `eqP` (map unpackT . TL.group)
prop_T_groupBy p       = L.groupBy p   `eqP` (map unpackT . T.groupBy p)
prop_TL_groupBy p      = L.groupBy p   `eqP` (map unpackT . TL.groupBy p)
prop_T_inits           = L.inits       `eqP` (map unpackT . T.inits)
prop_TL_inits          = L.inits       `eqP` (map unpackT . TL.inits)
prop_T_tails           = L.tails       `eqP` (map unpackT . T.tails)
prop_TL_tails          = L.tails       `eqP` (map unpackT . TL.tails)

prop_T_split_i c       = id `eq` (T.intercalate (T.singleton c) . T.split c)
prop_TL_split_i c      = id `eq` (TL.intercalate (TL.singleton c) . TL.split c)

prop_T_splitWith p     = splitWith p `eqP` (map unpackT . T.splitWith p)
prop_TL_splitWith p    = splitWith p `eqP` (map unpackT . TL.splitWith p)

splitWith :: (a -> Bool) -> [a] -> [[a]]
splitWith _ [] =  []
splitWith p xs = loop xs
    where loop s | null s'   = [l]
                 | otherwise = l : loop (tail s')
              where (l, s') = break p s

prop_T_breakSubstring_isInfixOf s l
                     = T.isInfixOf s l ==
                       T.null s || (not . T.null . snd $ T.breakSubstring s l)
prop_T_breakSubstringC c
                     = L.break (==c) `eqP`
                       (unpack2 . T.breakSubstring (T.singleton c))

prop_T_lines           = L.lines       `eqP` (map unpackT . T.lines)
{-
prop_T_lines'          = lines'        `eqP` (map unpackT . T.lines')
    where lines' "" =  []
          lines' s =  let (l, s') = break eol s
                      in  l : case s' of
                                []      -> []
                                ('\r':'\n':s'') -> lines' s''
                                (_:s'') -> lines' s''
          eol c = c == '\r' || c == '\n'
-}
prop_T_words           = L.words       `eqP` (map unpackT . T.words)
prop_T_unlines         = L.unlines     `eq`  (unpackT . T.unlines . map T.pack)
prop_T_unwords         = L.unwords     `eq`  (unpackT . T.unwords . map T.pack)

prop_T_isPrefixOf s    = L.isPrefixOf s`eqP` T.isPrefixOf (T.pack s)
prop_T_isPrefixOfS s   = L.isPrefixOf s`eqP` (S.isPrefixOf (S.stream $ T.pack s) . S.stream)
prop_T_isSuffixOf s    = L.isSuffixOf s`eqP` T.isSuffixOf (T.pack s)
prop_T_isInfixOf s     = L.isInfixOf s `eqP` T.isInfixOf (T.pack s)

prop_T_elem c          = L.elem c      `eqP` T.elem c
prop_T_filter p        = L.filter p    `eqP` (unpackT . T.filter p)
prop_T_find p          = L.find p      `eqP` T.find p
prop_T_partition p     = L.partition p `eqP` (unpack2 . T.partition p)

prop_T_index x s       = x < L.length s && x >= 0 ==>
                       (L.!!) s x == T.index (T.pack s) x
prop_T_findIndex p     = L.findIndex p `eqP` T.findIndex p
prop_T_findIndices p   = L.findIndices p`eqP` T.findIndices p
prop_T_elemIndex c     = L.elemIndex c `eqP` T.elemIndex c
prop_T_elemIndices c   = L.elemIndices c`eqP` T.elemIndices c
prop_T_count c         = (L.length . L.elemIndices c) `eqP` T.count c
prop_T_zipWith c s     = L.zipWith c s `eqP` (unpackT . T.zipWith c (T.pack s))

-- Regression tests.
prop_S_filter_eq s = S.filter p t == S.streamList (filter p s)
    where p = (/= S.last t)
          t = S.streamList s

-- Make a stream appear shorter than it really is, to ensure that
-- functions that consume inaccurately sized streams behave
-- themselves.
shorten :: Int -> S.Stream a -> S.Stream a
shorten n t@(S.Stream arr off len)
    | n < len && n > 0 = S.Stream arr off n
    | otherwise        = t

main = run tests =<< getArgs

run :: [(String, Int -> IO (Bool,Int))] -> [String] -> IO ()
run tests args = do
  let n = case args of
            [s] -> read s
            []  -> 100
            _   -> error "too many arguments"
  (results,passed) <- unzip <$> mapM (\(s,a) -> printf "%-40s: " s >> a n) tests
  printf "Passed %d tests!\n" (sum passed)
  when (not . and $ results) $
      fail "Not all tests passed!"

tests :: [(String, Int -> IO (Bool, Int))]
tests = [
  ("prop_T_pack_unpack", mytest prop_T_pack_unpack),
  ("prop_TL_pack_unpack", mytest prop_TL_pack_unpack),
  ("prop_T_stream_unstream", mytest prop_T_stream_unstream),
  ("prop_TL_stream_unstream", mytest prop_TL_stream_unstream),
  ("prop_T_reverse_stream", mytest prop_T_reverse_stream),
  ("prop_T_singleton", mytest prop_T_singleton),
  ("prop_TL_singleton", mytest prop_TL_singleton),
  ("prop_TL_unstreamChunks", mytest prop_TL_unstreamChunks),
  ("prop_TL_chunk_unchunk", mytest prop_TL_chunk_unchunk),

  ("prop_T_ascii", mytest prop_T_ascii),
  ("prop_T_utf8", mytest prop_T_utf8),
{'fraction_non_alphanumeric': 0.12395872186994902, 'fraction_numerical': 0.005843590699987567, 'mean_word_length': 2.034329906630199, 'pattern_counts': {'":': 2, '<': 15, '<?xml version=': 0, '>': 157, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 2, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5589179', 'n_tokens_mistral': 12656, 'n_tokens_neox': 12419, 'n_words': 3585}