text 0.11.2.2 → 0.11.2.3
raw patch · 100 files changed
+3679/−3443 lines, 100 filesdep +textdep ~HUnitdep ~QuickCheckdep ~basePVP ok
version bump matches the API change (PVP)
Dependencies added: text
Dependency ranges changed: HUnit, QuickCheck, base, bytestring, deepseq, directory, integer-gmp, random, test-framework, test-framework-hunit, test-framework-quickcheck2
API changes (from Hackage documentation)
Files
- Data/Text.hs +4/−4
- Data/Text/Encoding.hs +24/−23
- Data/Text/Encoding/Error.hs +1/−1
- Data/Text/Encoding/Utf8.hs +1/−1
- Data/Text/Fusion.hs +8/−8
- Data/Text/Fusion/Common.hs +1/−2
- Data/Text/Fusion/Internal.hs +0/−2
- Data/Text/IO.hs +11/−11
- Data/Text/IO/Internal.hs +4/−5
- Data/Text/Lazy.hs +3/−3
- Data/Text/Lazy/Builder.hs +4/−4
- Data/Text/Lazy/Builder/Int.hs +44/−15
- Data/Text/Lazy/Encoding/Fusion.hs +1/−1
- Data/Text/Lazy/Fusion.hs +5/−3
- Data/Text/Lazy/IO.hs +6/−6
- Data/Text/Lazy/Internal.hs +1/−1
- Data/Text/Private.hs +11/−2
- Data/Text/Search.hs +7/−6
- Data/Text/Unsafe.hs +1/−1
- Data/Text/Unsafe/Base.hs +1/−1
- benchmarks/Setup.hs +2/−0
- benchmarks/cbits/time_iconv.c +35/−0
- benchmarks/haskell/Benchmarks.hs +73/−0
- benchmarks/haskell/Benchmarks/Builder.hs +48/−0
- benchmarks/haskell/Benchmarks/DecodeUtf8.hs +59/−0
- benchmarks/haskell/Benchmarks/EncodeUtf8.hs +33/−0
- benchmarks/haskell/Benchmarks/Equality.hs +38/−0
- benchmarks/haskell/Benchmarks/FileRead.hs +33/−0
- benchmarks/haskell/Benchmarks/FoldLines.hs +58/−0
- benchmarks/haskell/Benchmarks/Pure.hs +474/−0
- benchmarks/haskell/Benchmarks/ReadNumbers.hs +96/−0
- benchmarks/haskell/Benchmarks/Replace.hs +31/−0
- benchmarks/haskell/Benchmarks/Search.hs +48/−0
- benchmarks/haskell/Benchmarks/Stream.hs +94/−0
- benchmarks/haskell/Benchmarks/WordFrequencies.hs +36/−0
- benchmarks/haskell/Multilang.hs +32/−0
- benchmarks/haskell/Timer.hs +30/−0
- benchmarks/python/cut.py +12/−0
- benchmarks/python/multilang.py +50/−0
- benchmarks/python/sort.py +13/−0
- benchmarks/python/strip_tags.py +25/−0
- benchmarks/python/utils.py +18/−0
- benchmarks/ruby/cut.rb +16/−0
- benchmarks/ruby/fold.rb +50/−0
- benchmarks/ruby/sort.rb +15/−0
- benchmarks/ruby/strip_tags.rb +22/−0
- benchmarks/ruby/utils.rb +14/−0
- benchmarks/text-benchmarks.cabal +46/−0
- cbits/cbits.c +1/−1
- scripts/Arsec.hs +1/−1
- tests-and-benchmarks.markdown +63/−0
- tests/.ghci +1/−0
- tests/Makefile +35/−0
- tests/README.markdown +0/−63
- tests/Tests.hs +13/−0
- tests/Tests/IO.hs +34/−0
- tests/Tests/Properties.hs +1189/−0
- tests/Tests/QuickCheckUtils.hs +337/−0
- tests/Tests/Regressions.hs +57/−0
- tests/Tests/SlowFunctions.hs +39/−0
- tests/Tests/Utils.hs +52/−0
- tests/benchmarks/Setup.hs +0/−2
- tests/benchmarks/cbits/time_iconv.c +0/−35
- tests/benchmarks/python/cut.py +0/−12
- tests/benchmarks/python/sort.py +0/−13
- tests/benchmarks/python/strip_tags.py +0/−25
- tests/benchmarks/python/utils.py +0/−18
- tests/benchmarks/ruby/cut.rb +0/−16
- tests/benchmarks/ruby/fold.rb +0/−50
- tests/benchmarks/ruby/sort.rb +0/−15
- tests/benchmarks/ruby/strip_tags.rb +0/−22
- tests/benchmarks/ruby/utils.rb +0/−14
- tests/benchmarks/src/Data/Text/Benchmarks.hs +0/−73
- tests/benchmarks/src/Data/Text/Benchmarks/Builder.hs +0/−48
- tests/benchmarks/src/Data/Text/Benchmarks/DecodeUtf8.hs +0/−59
- tests/benchmarks/src/Data/Text/Benchmarks/EncodeUtf8.hs +0/−33
- tests/benchmarks/src/Data/Text/Benchmarks/Equality.hs +0/−38
- tests/benchmarks/src/Data/Text/Benchmarks/FileRead.hs +0/−33
- tests/benchmarks/src/Data/Text/Benchmarks/FoldLines.hs +0/−58
- tests/benchmarks/src/Data/Text/Benchmarks/Pure.hs +0/−474
- tests/benchmarks/src/Data/Text/Benchmarks/ReadNumbers.hs +0/−96
- tests/benchmarks/src/Data/Text/Benchmarks/Replace.hs +0/−31
- tests/benchmarks/src/Data/Text/Benchmarks/Search.hs +0/−48
- tests/benchmarks/src/Data/Text/Benchmarks/Stream.hs +0/−94
- tests/benchmarks/src/Data/Text/Benchmarks/WordFrequencies.hs +0/−36
- tests/benchmarks/text-benchmarks.cabal +0/−36
- tests/scripts/cover-stdio.sh +62/−0
- tests/tests/.ghci +0/−1
- tests/tests/Makefile +0/−29
- tests/tests/scripts/cover-stdio.sh +0/−62
- tests/tests/src/Data/Text/Tests.hs +0/−13
- tests/tests/src/Data/Text/Tests/IO.hs +0/−34
- tests/tests/src/Data/Text/Tests/Properties.hs +0/−1118
- tests/tests/src/Data/Text/Tests/QuickCheckUtils.hs +0/−337
- tests/tests/src/Data/Text/Tests/Regressions.hs +0/−57
- tests/tests/src/Data/Text/Tests/SlowFunctions.hs +0/−39
- tests/tests/src/Data/Text/Tests/Utils.hs +0/−52
- tests/tests/text-tests.cabal +0/−124
- tests/text-tests.cabal +123/−0
- text.cabal +33/−33
Data/Text.hs view
@@ -167,7 +167,7 @@ , partition -- , findSubstring- + -- * Indexing -- $index , index@@ -330,7 +330,7 @@ -- This instance preserves data abstraction at the cost of inefficiency. -- We omit reflection services for the sake of data abstraction.--- +-- -- This instance was created by copying the behavior of Data.Set and -- Data.Map. If you feel a mistake has been made, please feel free to -- submit improvements.@@ -1129,7 +1129,7 @@ where go !i | i >= len || q c = i | otherwise = go (i+d) where Iter c d = iter t i- + -- | /O(n)/ Group characters in a string by equality. group :: Text -> [Text] group = groupBy (==)@@ -1162,7 +1162,7 @@ -- > splitOn "\r\n" "a\r\nb\r\nd\r\ne" == ["a","b","d","e"] -- > splitOn "aaa" "aaaXaaaXaaaXaaa" == ["","X","X","X",""] -- > splitOn "x" "x" == ["",""]--- +-- -- and -- -- > intercalate s . splitOn s == id
Data/Text/Encoding.hs view
@@ -57,7 +57,8 @@ import Data.ByteString as B import Data.ByteString.Internal as B import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)-import Data.Text.Internal (Text(..), textP)+import Data.Text.Internal (Text(..))+import Data.Text.Private (runText) import Data.Text.UnsafeChar (ord, unsafeWrite) import Data.Text.UnsafeShift (shiftL, shiftR) import Data.Word (Word8)@@ -96,30 +97,30 @@ -- | Decode a 'ByteString' containing UTF-8 encoded text. decodeUtf8With :: OnDecodeError -> ByteString -> Text-decodeUtf8With onErr (PS fp off len) = textP (fst a) 0 (snd a)+decodeUtf8With onErr (PS fp off len) = runText $ \done -> do+ let go dest = withForeignPtr fp $ \ptr ->+ with (0::CSize) $ \destOffPtr -> do+ let end = ptr `plusPtr` (off + len)+ loop curPtr = do+ curPtr' <- c_decode_utf8 (A.maBA dest) destOffPtr curPtr end+ if curPtr' == end+ then do+ n <- peek destOffPtr+ unsafeSTToIO (done dest (fromIntegral n))+ else do+ x <- peek curPtr'+ case onErr desc (Just x) of+ Nothing -> loop $ curPtr' `plusPtr` 1+ Just c -> do+ destOff <- peek destOffPtr+ w <- unsafeSTToIO $+ unsafeWrite dest (fromIntegral destOff) c+ poke destOffPtr (destOff + fromIntegral w)+ loop $ curPtr' `plusPtr` 1+ loop (ptr `plusPtr` off)+ (unsafeIOToST . go) =<< A.new len where- a = A.run2 (A.new len >>= unsafeIOToST . go) desc = "Data.Text.Encoding.decodeUtf8: Invalid UTF-8 stream"- go dest = withForeignPtr fp $ \ptr ->- with (0::CSize) $ \destOffPtr -> do- let end = ptr `plusPtr` (off + len)- loop curPtr = do- curPtr' <- c_decode_utf8 (A.maBA dest) destOffPtr curPtr end- if curPtr' == end- then do- n <- peek destOffPtr- return (dest,fromIntegral n)- else do- x <- peek curPtr'- case onErr desc (Just x) of- Nothing -> loop $ curPtr' `plusPtr` 1- Just c -> do- destOff <- peek destOffPtr- w <- unsafeSTToIO $- unsafeWrite dest (fromIntegral destOff) c- poke destOffPtr (destOff + fromIntegral w)- loop $ curPtr' `plusPtr` 1- loop (ptr `plusPtr` off) {- INLINE[0] decodeUtf8With #-} -- | Decode a 'ByteString' containing UTF-8 encoded text that is known
Data/Text/Encoding/Error.hs view
@@ -88,7 +88,7 @@ = "Cannot encode character '\\x" ++ showHex (fromEnum c) ("': " ++ desc) showUnicodeException (EncodeError desc Nothing) = "Cannot encode input: " ++ desc- + instance Show UnicodeException where show = showUnicodeException
Data/Text/Encoding/Utf8.hs view
@@ -146,7 +146,7 @@ validate4 :: Word8 -> Word8 -> Word8 -> Word8 -> Bool {-# INLINE validate4 #-} validate4 x1 x2 x3 x4 = validate4_1 || validate4_2 || validate4_3- where + where validate4_1 = x1 == 0xF0 && between x2 0x90 0xBF && between x3 0x80 0xBF &&
Data/Text/Fusion.hs view
@@ -51,6 +51,7 @@ fromIntegral, otherwise) import Data.Bits ((.&.)) import Data.Text.Internal (Text(..))+import Data.Text.Private (runText) import Data.Text.UnsafeChar (ord, unsafeChr, unsafeWrite) import Data.Text.UnsafeShift (shiftL, shiftR) import qualified Data.Text.Array as A@@ -59,7 +60,6 @@ import Data.Text.Fusion.Size import qualified Data.Text.Internal as I import qualified Data.Text.Encoding.Utf16 as U16-import qualified Prelude as P default(Int) @@ -94,15 +94,14 @@ -- | /O(n)/ Convert a 'Stream Char' into a 'Text'. unstream :: Stream Char -> Text-unstream (Stream next0 s0 len) = I.textP (P.fst a) 0 (P.snd a)- where- a = A.run2 (A.new mlen >>= \arr -> outer arr mlen s0 0)- where mlen = upperBound 4 len- outer arr top = loop- where+unstream (Stream next0 s0 len) = runText $ \done -> do+ let mlen = upperBound 4 len+ arr0 <- A.new mlen+ let outer arr top = loop+ where loop !s !i = case next0 s of- Done -> return (arr, i)+ Done -> done arr i Skip s' -> loop s' i Yield x s' | j >= top -> {-# SCC "unstream/resize" #-} do@@ -114,6 +113,7 @@ loop s' (i+d) where j | ord x < 0x10000 = i | otherwise = i + 1+ outer arr0 mlen s0 0 {-# INLINE [0] unstream #-} {-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}
Data/Text/Fusion/Common.hs view
@@ -307,7 +307,7 @@ -- of 'lengthI', but can short circuit if the count of characters is -- greater than the number, and hence be more efficient. compareLengthI :: Integral a => Stream Char -> a -> Ordering-compareLengthI (Stream next s0 len) n = +compareLengthI (Stream next s0 len) n = case exactly len of Nothing -> loop_cmp 0 s0 Just i -> compare (fromIntegral i) n@@ -776,7 +776,6 @@ loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 && loop (next1 s1') (next2 s2') {-# INLINE [0] isPrefixOf #-}-{-# SPECIALISE isPrefixOf :: Stream Char -> Stream Char -> Bool #-} -- ---------------------------------------------------------------------------- -- * Searching
Data/Text/Fusion/Internal.hs view
@@ -101,7 +101,6 @@ loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 && loop (next1 s1') (next2 s2') {-# INLINE [0] eq #-}-{-# SPECIALISE eq :: Stream Char -> Stream Char -> Bool #-} cmp :: (Ord a) => Stream a -> Stream a -> Ordering cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)@@ -117,7 +116,6 @@ EQ -> loop (next1 s1') (next2 s2') other -> other {-# INLINE [0] cmp #-}-{-# SPECIALISE cmp :: Stream Char -> Stream Char -> Ordering #-} -- | The empty stream. empty :: Stream a
Data/Text/IO.hs view
@@ -16,7 +16,7 @@ module Data.Text.IO ( -- * Performance- -- $performance + -- $performance -- * Locale support -- $locale@@ -38,7 +38,7 @@ ) where import Data.Text (Text)-import Prelude hiding (appendFile, catch, getContents, getLine, interact,+import Prelude hiding (appendFile, getContents, getLine, interact, putStr, putStrLn, readFile, writeFile) import System.IO (Handle, IOMode(..), hPutChar, openFile, stdin, stdout, withFile)@@ -46,7 +46,7 @@ import qualified Data.ByteString.Char8 as B import Data.Text.Encoding (decodeUtf8, encodeUtf8) #else-import Control.Exception (catch, throwIO)+import qualified Control.Exception as E import Control.Monad (liftM2, when) import Data.IORef (readIORef, writeIORef) import qualified Data.Text as T@@ -123,17 +123,17 @@ return $ if isEmptyBuffer buf then T.empty else T.singleton '\r'- | otherwise = throwIO (augmentIOError e "hGetContents" h)+ | otherwise = E.throwIO (augmentIOError e "hGetContents" h) readChunks = do buf <- readIORef haCharBuffer- t <- readChunk hh buf `catch` catchError+ t <- readChunk hh buf `E.catch` catchError if T.null t then return [t] else (t:) `fmap` readChunks ts <- readChunks (hh', _) <- hClose_help hh return (hh'{haType=ClosedHandle}, T.concat ts)- + -- | Use a more efficient buffer size if we're reading in -- block-buffered mode with the default buffer size. When we can -- determine the size of the handle we're reading, set the buffer size@@ -144,10 +144,10 @@ bufMode <- hGetBuffering h case bufMode of BlockBuffering Nothing -> do- d <- catch (liftM2 (-) (hFileSize h) (hTell h)) $ \(e::IOException) ->+ d <- E.catch (liftM2 (-) (hFileSize h) (hTell h)) $ \(e::IOException) -> if ioe_type e == InappropriateType then return 16384 -- faster than the 2KB default- else throwIO e+ else E.throwIO e when (d > 0) . hSetBuffering h . BlockBuffering . Just . fromIntegral $ d _ -> return () #endif@@ -167,7 +167,7 @@ #else -- This function is lifted almost verbatim from GHC.IO.Handle.Text. hPutStr h t = do- (buffer_mode, nl) <- + (buffer_mode, nl) <- wantWritableHandle "hPutStr" h $ \h_ -> do bmode <- getSpareBuffer h_ return (bmode, haOutputNL h_)@@ -249,7 +249,7 @@ -- This function is completely lifted from GHC.IO.Handle.Text. getSpareBuffer :: Handle__ -> IO (BufferMode, CharBuffer)-getSpareBuffer Handle__{haCharBuffer=ref, +getSpareBuffer Handle__{haCharBuffer=ref, haBuffers=spare_ref, haBufferMode=mode} = do@@ -270,7 +270,7 @@ -- This function is completely lifted from GHC.IO.Handle.Text. commitBuffer :: Handle -> RawCharBuffer -> Int -> Int -> Bool -> Bool -> IO CharBuffer-commitBuffer hdl !raw !sz !count flush release = +commitBuffer hdl !raw !sz !count flush release = wantWritableHandle "commitAndReleaseBuffer" hdl $ commitBuffer' raw sz count flush release {-# INLINE commitBuffer #-}
Data/Text/IO/Internal.hs view
@@ -19,7 +19,7 @@ ) where #if __GLASGOW_HASKELL__ >= 612-import Control.Exception (catch)+import qualified Control.Exception as E import Data.IORef (readIORef, writeIORef) import Data.Text (Text) import Data.Text.Fusion (unstream)@@ -32,7 +32,6 @@ withRawBuffer, writeCharBuf) import GHC.IO.Handle.Internals (ioe_EOF, readTextDevice, wantReadableHandle_) import GHC.IO.Handle.Types (Handle__(..), Newline(..))-import Prelude hiding (catch) import System.IO (Handle) import System.IO.Error (isEOFError) import qualified Data.Text as T@@ -84,9 +83,9 @@ -- This function is lifted almost verbatim from GHC.IO.Handle.Text. maybeFillReadBuffer :: Handle__ -> CharBuffer -> IO (Maybe CharBuffer) maybeFillReadBuffer handle_ buf- = catch (Just `fmap` getSomeCharacters handle_ buf) $ \e ->- if isEOFError e - then return Nothing + = E.catch (Just `fmap` getSomeCharacters handle_ buf) $ \e ->+ if isEOFError e+ then return Nothing else ioError e unpack :: RawCharBuffer -> Int -> Int -> IO Text
Data/Text/Lazy.hs view
@@ -174,7 +174,7 @@ , partition -- , findSubstring- + -- * Indexing , index , count@@ -921,7 +921,7 @@ | otherwise = drop' i t0 where drop' 0 ts = ts drop' _ Empty = Empty- drop' n (Chunk t ts) + drop' n (Chunk t ts) | n < len = Chunk (T.drop (fromIntegral n) t) ts | otherwise = drop' (n - len) ts where len = fromIntegral (T.length t)@@ -1209,7 +1209,7 @@ -- > splitOn "\r\n" "a\r\nb\r\nd\r\ne" == ["a","b","d","e"] -- > splitOn "aaa" "aaaXaaaXaaaXaaa" == ["","X","X","X",""] -- > splitOn "x" "x" == ["",""]--- +-- -- and -- -- > intercalate s . splitOn s == id
Data/Text/Lazy/Builder.hs view
@@ -5,7 +5,7 @@ -- Module : Data.Text.Lazy.Builder -- Copyright : (c) 2010 Johan Tibell -- License : BSD3-style (see LICENSE)--- +-- -- Maintainer : Johan Tibell <johan.tibell@gmail.com> -- Stability : experimental -- Portability : portable to Hugs and GHC@@ -139,7 +139,7 @@ -- TODO: Experiment to find the right threshold. copyLimit :: Int-copyLimit = 128 +copyLimit = 128 -- This function attempts to merge small @Text@ values instead of -- treating each value as its own chunk. We may not always want this.@@ -292,14 +292,14 @@ "append/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int) (g::forall s. A.MArray s -> Int -> ST s Int) ws. append (writeAtMost a f) (append (writeAtMost b g) ws) =- append (writeAtMost (a+b) (\marr o -> f marr o >>= \ n -> + append (writeAtMost (a+b) (\marr o -> f marr o >>= \ n -> g marr (o+n) >>= \ m -> let s = n+m in s `seq` return s)) ws "writeAtMost/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int) (g::forall s. A.MArray s -> Int -> ST s Int). append (writeAtMost a f) (writeAtMost b g) =- writeAtMost (a+b) (\marr o -> f marr o >>= \ n -> + writeAtMost (a+b) (\marr o -> f marr o >>= \ n -> g marr (o+n) >>= \ m -> let s = n+m in s `seq` return s)
Data/Text/Lazy/Builder/Int.hs view
@@ -43,24 +43,52 @@ #endif decimal :: Integral a => a -> Builder-{-# SPECIALIZE decimal :: Int -> Builder #-} {-# SPECIALIZE decimal :: Int8 -> Builder #-}-{-# SPECIALIZE decimal :: Int16 -> Builder #-}-{-# SPECIALIZE decimal :: Int32 -> Builder #-}-{-# SPECIALIZE decimal :: Int64 -> Builder #-}-{-# SPECIALIZE decimal :: Word -> Builder #-}-{-# SPECIALIZE decimal :: Word8 -> Builder #-}-{-# SPECIALIZE decimal :: Word16 -> Builder #-}-{-# SPECIALIZE decimal :: Word32 -> Builder #-}-{-# SPECIALIZE decimal :: Word64 -> Builder #-}+{-# RULES "decimal/Int" decimal = boundedDecimal :: Int -> Builder #-}+{-# RULES "decimal/Int16" decimal = boundedDecimal :: Int16 -> Builder #-}+{-# RULES "decimal/Int32" decimal = boundedDecimal :: Int32 -> Builder #-}+{-# RULES "decimal/Int64" decimal = boundedDecimal :: Int64 -> Builder #-}+{-# RULES "decimal/Word" decimal = positive :: Word -> Builder #-}+{-# RULES "decimal/Word8" decimal = positive :: Word8 -> Builder #-}+{-# RULES "decimal/Word16" decimal = positive :: Word16 -> Builder #-}+{-# RULES "decimal/Word32" decimal = positive :: Word32 -> Builder #-}+{-# RULES "decimal/Word64" decimal = positive :: Word64 -> Builder #-} {-# RULES "decimal/Integer" decimal = integer 10 :: Integer -> Builder #-} decimal i- | i < 0 = singleton '-' <> go (-i)- | otherwise = go i- where- go n | n < 10 = digit n- | otherwise = go (n `quot` 10) <> digit (n `rem` 10)+ | i < 0 = singleton '-' <>+ if i <= -128+ then positive (-(i `quot` 10)) <> digit (-(i `rem` 10))+ else positive (-i)+ | otherwise = positive i +boundedDecimal :: (Integral a, Bounded a) => a -> Builder+{-# SPECIALIZE boundedDecimal :: Int -> Builder #-}+{-# SPECIALIZE boundedDecimal :: Int8 -> Builder #-}+{-# SPECIALIZE boundedDecimal :: Int16 -> Builder #-}+{-# SPECIALIZE boundedDecimal :: Int32 -> Builder #-}+{-# SPECIALIZE boundedDecimal :: Int64 -> Builder #-}+boundedDecimal i+ | i < 0 = singleton '-' <>+ if i == minBound+ then positive (-(i `quot` 10)) <> digit (-(i `rem` 10))+ else positive (-i)+ | otherwise = positive i++positive :: (Integral a) => a -> Builder+{-# SPECIALIZE positive :: Int -> Builder #-}+{-# SPECIALIZE positive :: Int8 -> Builder #-}+{-# SPECIALIZE positive :: Int16 -> Builder #-}+{-# SPECIALIZE positive :: Int32 -> Builder #-}+{-# SPECIALIZE positive :: Int64 -> Builder #-}+{-# SPECIALIZE positive :: Word -> Builder #-}+{-# SPECIALIZE positive :: Word8 -> Builder #-}+{-# SPECIALIZE positive :: Word16 -> Builder #-}+{-# SPECIALIZE positive :: Word32 -> Builder #-}+{-# SPECIALIZE positive :: Word64 -> Builder #-}+positive = go+ where go n | n < 10 = digit n+ | otherwise = go (n `quot` 10) <> digit (n `rem` 10)+ hexadecimal :: Integral a => a -> Builder {-# SPECIALIZE hexadecimal :: Int -> Builder #-} {-# SPECIALIZE hexadecimal :: Int8 -> Builder #-}@@ -74,11 +102,12 @@ {-# SPECIALIZE hexadecimal :: Word64 -> Builder #-} {-# RULES "hexadecimal/Integer" hexadecimal = integer 16 :: Integer -> Builder #-} hexadecimal i- | i < 0 = singleton '-' <> go (-i)+ | i < 0 = error msg | otherwise = go i where go n | n < 16 = hexDigit n | otherwise = go (n `quot` 16) <> hexDigit (n `rem` 16)+ msg = "Data.Text.Lazy.Builder.Int.hexadecimal: applied to negative number" digit :: Integral a => a -> Builder digit n = singleton $! i2d (fromIntegral n)
Data/Text/Lazy/Encoding/Fusion.hs view
@@ -5,7 +5,7 @@ -- Copyright : (c) 2009, 2010 Bryan O'Sullivan -- -- License : BSD-style--- Maintainer : bos@serpentine.com, rtomharper@googlemail.com, +-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com, -- duncan@haskell.org -- Stability : experimental -- Portability : portable
Data/Text/Lazy/Fusion.hs view
@@ -47,6 +47,8 @@ where Iter c d = iter t i {-# INLINE [0] stream #-} +data UC s = UC s {-# UNPACK #-} !Int+ -- | /O(n)/ Convert a 'Stream Char' into a 'Text', using the given -- chunk size. unstreamChunks :: Int -> Stream Char -> Text@@ -59,12 +61,12 @@ Done -> Empty Skip s' -> outer s' Yield x s' -> I.Text arr 0 len `chunk` outer s''- where (arr,(s'',len)) = A.run2 fill+ where (arr, UC s'' len) = A.run2 fill fill = do a <- A.new unknownLength unsafeWrite a 0 x >>= inner a unknownLength s' unknownLength = 4 inner marr len s !i- | i + 1 >= chunkSize = return (marr, (s,i))+ | i + 1 >= chunkSize = return (marr, UC s i) | i + 1 >= len = {-# SCC "unstreamChunks/resize" #-} do let newLen = min (len `shiftL` 1) chunkSize marr' <- A.new newLen@@ -73,7 +75,7 @@ | otherwise = {-# SCC "unstreamChunks/inner" #-} case next s of- Done -> return (marr,(s,i))+ Done -> return (marr, UC s i) Skip s' -> inner marr len s' i Yield x s' -> do d <- unsafeWrite marr i x inner marr len s' (i+d)
Data/Text/Lazy/IO.hs view
@@ -16,7 +16,7 @@ module Data.Text.Lazy.IO ( -- * Performance- -- $performance + -- $performance -- * Locale support -- $locale@@ -38,7 +38,7 @@ ) where import Data.Text.Lazy (Text)-import Prelude hiding (appendFile, catch, getContents, getLine, interact,+import Prelude hiding (appendFile, getContents, getLine, interact, putStr, putStrLn, readFile, writeFile) import System.IO (Handle, IOMode(..), hPutChar, openFile, stdin, stdout, withFile)@@ -49,7 +49,7 @@ import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy.Char8 as L8 #else-import Control.Exception (catch, throwIO)+import qualified Control.Exception as E import Control.Monad (when) import Data.IORef (readIORef) import Data.Text.IO.Internal (hGetLineWith, readChunk)@@ -119,7 +119,7 @@ case haType hh of ClosedHandle -> return (hh, L.empty) SemiClosedHandle -> lazyReadBuffered h hh- _ -> ioException + _ -> ioException (IOError (Just h) IllegalOperation "hGetContents" "illegal handle type" Nothing Nothing) @@ -128,13 +128,13 @@ buf <- readIORef haCharBuffer (do t <- readChunk hh buf ts <- lazyRead h- return (hh, chunk t ts)) `catch` \e -> do+ return (hh, chunk t ts)) `E.catch` \e -> do (hh', _) <- hClose_help hh if isEOFError e then return $ if isEmptyBuffer buf then (hh', empty) else (hh', L.singleton '\r')- else throwIO (augmentIOError e "hGetContents" h)+ else E.throwIO (augmentIOError e "hGetContents" h) #endif -- | Read a single line from a handle.
Data/Text/Lazy/Internal.hs view
@@ -8,7 +8,7 @@ -- duncan@haskell.org -- Stability : experimental -- Portability : GHC--- +-- -- A module containing private 'Text' internals. This exposes the -- 'Text' representation and low level construction functions. -- Modules which extend the 'Text' system may need to use this module.
Data/Text/Private.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE BangPatterns, UnboxedTuples #-}+{-# LANGUAGE BangPatterns, Rank2Types, UnboxedTuples #-} -- | -- Module : Data.Text.Private@@ -11,11 +11,14 @@ module Data.Text.Private (- span_+ runText+ , span_ ) where +import Control.Monad.ST (ST, runST) import Data.Text.Internal (Text(..), textP) import Data.Text.Unsafe (Iter(..), iter)+import qualified Data.Text.Array as A span_ :: (Char -> Bool) -> Text -> (# Text, Text #) span_ p t@(Text arr off len) = (# hd,tl #)@@ -26,3 +29,9 @@ | otherwise = i where Iter c d = iter t i {-# INLINE span_ #-}++runText :: (forall s. (A.MArray s -> Int -> ST s Text) -> ST s Text) -> Text+runText act = runST (act $ \ !marr !len -> do+ arr <- A.unsafeFreeze marr+ return $! textP arr 0 len)+{-# INLINE runText #-}
Data/Text/Search.hs view
@@ -14,7 +14,7 @@ -- Horspool, Sunday, and Lundh. -- -- References:--- +-- -- * R. S. Boyer, J. S. Moore: A Fast String Searching Algorithm. -- Communications of the ACM, 20, 10, 762-772 (1977) --@@ -35,10 +35,11 @@ import qualified Data.Text.Array as A import Data.Word (Word64) import Data.Text.Internal (Text(..))-import Data.Text.Fusion.Internal (PairS(..)) import Data.Bits ((.|.), (.&.)) import Data.Text.UnsafeShift (shiftL) +data T = {-# UNPACK #-} !Word64 :* {-# UNPACK #-} !Int+ -- | /O(n+m)/ Find the offsets of all non-overlapping indices of -- @needle@ within @haystack@. The offsets returned represent -- locations in the low-level array.@@ -60,9 +61,8 @@ hindex k = A.unsafeIndex harr (hoff+k) hindex' k | k == hlen = 0 | otherwise = A.unsafeIndex harr (hoff+k)- (mask :: Word64) :*: skip = buildTable 0 0 (nlen-2) buildTable !i !msk !skp- | i >= nlast = (msk .|. swizzle z) :*: skp+ | i >= nlast = (msk .|. swizzle z) :* skp | otherwise = buildTable (i+1) (msk .|. swizzle c) skp' where c = nindex i skp' | c == z = nlen - i - 2@@ -80,9 +80,10 @@ delta | nextInPattern = nlen + 1 | c == z = skip + 1 | otherwise = 1- nextInPattern = mask .&. swizzle (hindex' (i+nlen)) == 0+ where nextInPattern = mask .&. swizzle (hindex' (i+nlen)) == 0+ !(mask :* skip) = buildTable 0 0 (nlen-2) scanOne c = loop 0 where loop !i | i >= hlen = [] | hindex i == c = i : loop (i+1) | otherwise = loop (i+1)-{-# INLINE indices #-}+{- INLINE indices #-}
Data/Text/Unsafe.hs view
@@ -24,7 +24,7 @@ , takeWord16 , dropWord16 ) where- + #if defined(ASSERTS) import Control.Exception (assert) #endif
Data/Text/Unsafe/Base.hs view
@@ -15,7 +15,7 @@ inlineInterleaveST , inlinePerformIO ) where- + import GHC.ST (ST(..)) #if defined(__GLASGOW_HASKELL__) # if __GLASGOW_HASKELL__ >= 611
+ benchmarks/Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ benchmarks/cbits/time_iconv.c view
@@ -0,0 +1,35 @@+#include <iconv.h>+#include <stdlib.h>+#include <stdio.h>+#include <stdint.h>++int time_iconv(char *srcbuf, size_t srcbufsize)+{+ uint16_t *destbuf = NULL;+ size_t destbufsize;+ static uint16_t *origdestbuf;+ static size_t origdestbufsize;+ iconv_t ic = (iconv_t) -1;+ int ret = 0;++ if (ic == (iconv_t) -1) {+ ic = iconv_open("UTF-16LE", "UTF-8");+ if (ic == (iconv_t) -1) {+ ret = -1;+ goto done;+ }+ }+ + destbufsize = srcbufsize * sizeof(uint16_t);+ if (destbufsize > origdestbufsize) {+ free(origdestbuf);+ origdestbuf = destbuf = malloc(origdestbufsize = destbufsize);+ } else {+ destbuf = origdestbuf;+ }++ iconv(ic, &srcbuf, &srcbufsize, (char**) &destbuf, &destbufsize);++ done:+ return ret;+}
+ benchmarks/haskell/Benchmarks.hs view
@@ -0,0 +1,73 @@+-- | Main module to run the micro benchmarks+--+{-# LANGUAGE OverloadedStrings #-}+module Main+ ( main+ ) where++import Criterion.Main (Benchmark, defaultMain, bgroup)+import System.FilePath ((</>))+import System.IO (IOMode (WriteMode), openFile, hSetEncoding, utf8)++import qualified Benchmarks.Builder as Builder+import qualified Benchmarks.DecodeUtf8 as DecodeUtf8+import qualified Benchmarks.EncodeUtf8 as EncodeUtf8+import qualified Benchmarks.Equality as Equality+import qualified Benchmarks.FileRead as FileRead+import qualified Benchmarks.FoldLines as FoldLines+import qualified Benchmarks.Pure as Pure+import qualified Benchmarks.ReadNumbers as ReadNumbers+import qualified Benchmarks.Replace as Replace+import qualified Benchmarks.Search as Search+import qualified Benchmarks.Stream as Stream+import qualified Benchmarks.WordFrequencies as WordFrequencies++import qualified Benchmarks.Programs.BigTable as Programs.BigTable+import qualified Benchmarks.Programs.Cut as Programs.Cut+import qualified Benchmarks.Programs.Fold as Programs.Fold+import qualified Benchmarks.Programs.Sort as Programs.Sort+import qualified Benchmarks.Programs.StripTags as Programs.StripTags+import qualified Benchmarks.Programs.Throughput as Programs.Throughput++main :: IO ()+main = benchmarks >>= defaultMain++benchmarks :: IO [Benchmark]+benchmarks = do+ sink <- openFile "/dev/null" WriteMode+ hSetEncoding sink utf8++ -- Traditional benchmarks+ bs <- sequence+ [ Builder.benchmark+ , DecodeUtf8.benchmark "html" (tf "libya-chinese.html")+ , DecodeUtf8.benchmark "xml" (tf "yiwiki.xml")+ , DecodeUtf8.benchmark "ascii" (tf "ascii.txt")+ , DecodeUtf8.benchmark "russian" (tf "russian.txt")+ , DecodeUtf8.benchmark "japanese" (tf "japanese.txt")+ , EncodeUtf8.benchmark "επανάληψη 竺法蘭共譯"+ , Equality.benchmark (tf "japanese.txt")+ , FileRead.benchmark (tf "russian.txt")+ , FoldLines.benchmark (tf "russian.txt")+ , Pure.benchmark (tf "japanese.txt")+ , ReadNumbers.benchmark (tf "numbers.txt")+ , Replace.benchmark (tf "russian.txt") "принимая" "своем"+ , Search.benchmark (tf "russian.txt") "принимая"+ , Stream.benchmark (tf "russian.txt")+ , WordFrequencies.benchmark (tf "russian.txt")+ ]++ -- Program-like benchmarks+ ps <- bgroup "Programs" `fmap` sequence+ [ Programs.BigTable.benchmark sink+ , Programs.Cut.benchmark (tf "russian.txt") sink 20 40+ , Programs.Fold.benchmark (tf "russian.txt") sink+ , Programs.Sort.benchmark (tf "russian.txt") sink+ , Programs.StripTags.benchmark (tf "yiwiki.xml") sink+ , Programs.Throughput.benchmark (tf "russian.txt") sink+ ]++ return $ bs ++ [ps]+ where+ -- Location of a test file+ tf = ("../tests/text-test-data" </>)
+ benchmarks/haskell/Benchmarks/Builder.hs view
@@ -0,0 +1,48 @@+-- | Testing the internal builder monoid+--+-- Tested in this benchmark:+--+-- * Concatenating many small strings using a builder+--+{-# LANGUAGE OverloadedStrings #-}+module Benchmarks.Builder+ ( benchmark+ ) where++import Criterion (Benchmark, bgroup, bench, nf)+import Data.Binary.Builder as B+import Data.ByteString.Char8 ()+import Data.Monoid (mconcat)+import qualified Blaze.ByteString.Builder as Blaze+import qualified Blaze.ByteString.Builder.Char.Utf8 as Blaze+import qualified Data.ByteString as SB+import qualified Data.ByteString.Lazy as LB+import qualified Data.Text as T+import qualified Data.Text.Lazy as LT+import qualified Data.Text.Lazy.Builder as LTB++benchmark :: IO Benchmark+benchmark = return $ bgroup "Builder"+ [ bench "LazyText" $ nf+ (LT.length . LTB.toLazyText . mconcat . map LTB.fromText) texts+ , bench "Binary" $ nf+ (LB.length . B.toLazyByteString . mconcat . map B.fromByteString)+ byteStrings+ , bench "Blaze" $ nf+ (LB.length . Blaze.toLazyByteString . mconcat . map Blaze.fromString)+ strings+ ]++texts :: [T.Text]+texts = take 200000 $ cycle ["foo", "λx", "由の"]+{-# NOINLINE texts #-}++-- Note that the non-ascii characters will be chopped+byteStrings :: [SB.ByteString]+byteStrings = take 200000 $ cycle ["foo", "λx", "由の"]+{-# NOINLINE byteStrings #-}++-- Note that the non-ascii characters will be chopped+strings :: [String]+strings = take 200000 $ cycle ["foo", "λx", "由の"]+{-# NOINLINE strings #-}
+ benchmarks/haskell/Benchmarks/DecodeUtf8.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE ForeignFunctionInterface #-}++-- | Test decoding of UTF-8+--+-- Tested in this benchmark:+--+-- * Decoding bytes using UTF-8+--+-- In some tests:+--+-- * Taking the length of the result+--+-- * Taking the init of the result+--+-- The latter are used for testing stream fusion.+--+module Benchmarks.DecodeUtf8+ ( benchmark+ ) where++import Foreign.C.Types (CInt, CSize)+import Data.ByteString.Internal (ByteString(..))+import Foreign.Ptr (Ptr, plusPtr)+import Foreign.ForeignPtr (withForeignPtr)+import Data.Word (Word8)+import qualified Criterion as C+import Criterion (Benchmark, bgroup, nf)+import qualified Codec.Binary.UTF8.Generic as U8+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL++benchmark :: String -> FilePath -> IO Benchmark+benchmark kind fp = do+ bs <- B.readFile fp+ lbs <- BL.readFile fp+ let bench name = C.bench (name ++ "+" ++ kind)+ return $ bgroup "DecodeUtf8"+ [ bench "Strict" $ nf T.decodeUtf8 bs+ , bench "IConv" $ iconv bs+ , bench "StrictLength" $ nf (T.length . T.decodeUtf8) bs+ , bench "StrictInitLength" $ nf (T.length . T.init . T.decodeUtf8) bs+ , bench "Lazy" $ nf TL.decodeUtf8 lbs+ , bench "LazyLength" $ nf (TL.length . TL.decodeUtf8) lbs+ , bench "LazyInitLength" $ nf (TL.length . TL.init . TL.decodeUtf8) lbs+ , bench "StrictStringUtf8" $ nf U8.toString bs+ , bench "StrictStringUtf8Length" $ nf (length . U8.toString) bs+ , bench "LazyStringUtf8" $ nf U8.toString lbs+ , bench "LazyStringUtf8Length" $ nf (length . U8.toString) lbs+ ]++iconv :: ByteString -> IO CInt+iconv (PS fp off len) = withForeignPtr fp $ \ptr ->+ time_iconv (ptr `plusPtr` off) (fromIntegral len)++foreign import ccall unsafe time_iconv :: Ptr Word8 -> CSize -> IO CInt
+ benchmarks/haskell/Benchmarks/EncodeUtf8.hs view
@@ -0,0 +1,33 @@+-- | UTF-8 encode a text+--+-- Tested in this benchmark:+--+-- * Replicating a string a number of times+--+-- * UTF-8 encoding it+--+module Benchmarks.EncodeUtf8+ ( benchmark+ ) where++import Criterion (Benchmark, bgroup, bench, whnf)+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL++benchmark :: String -> IO Benchmark+benchmark string = do+ return $ bgroup "EncodeUtf8"+ [ bench "Text" $ whnf (B.length . T.encodeUtf8) text+ , bench "LazyText" $ whnf (BL.length . TL.encodeUtf8) lazyText+ ]+ where+ -- The string in different formats+ text = T.replicate k $ T.pack string+ lazyText = TL.replicate (fromIntegral k) $ TL.pack string++ -- Amount+ k = 100000
+ benchmarks/haskell/Benchmarks/Equality.hs view
@@ -0,0 +1,38 @@+-- | Compare a string with a copy of itself that is identical except+-- for the last character.+--+-- Tested in this benchmark:+--+-- * Comparison of strings (Eq instance)+--+module Benchmarks.Equality+ ( benchmark+ ) where++import Criterion (Benchmark, bgroup, bench, whnf)+import qualified Data.ByteString.Char8 as B+import qualified Data.ByteString.Lazy.Char8 as BL+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL++benchmark :: FilePath -> IO Benchmark+benchmark fp = do+ b <- B.readFile fp+ bl1 <- BL.readFile fp+ -- A lazy bytestring is a list of chunks. When we do not explicitly create two+ -- different lazy bytestrings at a different address, the bytestring library+ -- will compare the chunk addresses instead of the chunk contents. This is why+ -- we read the lazy bytestring twice here.+ bl2 <- BL.readFile fp+ l <- readFile fp+ let t = T.decodeUtf8 b+ tl = TL.decodeUtf8 bl1+ return $ bgroup "Equality"+ [ bench "Text" $ whnf (== T.init t `T.snoc` '\xfffd') t+ , bench "LazyText" $ whnf (== TL.init tl `TL.snoc` '\xfffd') tl+ , bench "ByteString" $ whnf (== B.init b `B.snoc` '\xfffd') b+ , bench "LazyByteString" $ whnf (== BL.init bl2 `BL.snoc` '\xfffd') bl1+ , bench "String" $ whnf (== init l ++ "\xfffd") l+ ]
+ benchmarks/haskell/Benchmarks/FileRead.hs view
@@ -0,0 +1,33 @@+-- | Benchmarks simple file reading+--+-- Tested in this benchmark:+--+-- * Reading a file from the disk+--+module Benchmarks.FileRead+ ( benchmark+ ) where++import Control.Exception (evaluate)+import Criterion (Benchmark, bgroup, bench)+import qualified Data.ByteString as SB+import qualified Data.ByteString.Lazy as LB+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.IO as T+import qualified Data.Text.Lazy as LT+import qualified Data.Text.Lazy.Encoding as LT+import qualified Data.Text.Lazy.IO as LT++benchmark :: FilePath -> IO Benchmark+benchmark p = return $ bgroup "FileRead"+ [ bench "String" $ readFile p >>= evaluate . length+ , bench "ByteString" $ SB.readFile p >>= evaluate . SB.length+ , bench "LazyByteString" $ LB.readFile p >>= evaluate . LB.length+ , bench "Text" $ T.readFile p >>= evaluate . T.length+ , bench "LazyText" $ LT.readFile p >>= evaluate . LT.length+ , bench "TextByteString" $+ SB.readFile p >>= evaluate . T.length . T.decodeUtf8+ , bench "LazyTextByteString" $+ LB.readFile p >>= evaluate . LT.length . LT.decodeUtf8+ ]
+ benchmarks/haskell/Benchmarks/FoldLines.hs view
@@ -0,0 +1,58 @@+-- | Read a file line-by-line using handles, and perform a fold over the lines.+-- The fold is used here to calculate the number of lines in the file.+--+-- Tested in this benchmark:+--+-- * Buffered, line-based IO+--+{-# LANGUAGE BangPatterns #-}+module Benchmarks.FoldLines+ ( benchmark+ ) where++import Criterion (Benchmark, bgroup, bench)+import System.IO+import qualified Data.ByteString as B+import qualified Data.Text as T+import qualified Data.Text.IO as T++benchmark :: FilePath -> IO Benchmark+benchmark fp = return $ bgroup "ReadLines"+ [ bench "Text" $ withHandle $ foldLinesT (\n _ -> n + 1) (0 :: Int)+ , bench "ByteString" $ withHandle $ foldLinesB (\n _ -> n + 1) (0 :: Int)+ ]+ where+ withHandle f = do+ h <- openFile fp ReadMode+ hSetBuffering h (BlockBuffering (Just 16384))+ x <- f h+ hClose h+ return x++-- | Text line fold+--+foldLinesT :: (a -> T.Text -> a) -> a -> Handle -> IO a+foldLinesT f z0 h = go z0+ where+ go !z = do+ eof <- hIsEOF h+ if eof+ then return z+ else do+ l <- T.hGetLine h+ let z' = f z l in go z'+{-# INLINE foldLinesT #-}++-- | ByteString line fold+--+foldLinesB :: (a -> B.ByteString -> a) -> a -> Handle -> IO a+foldLinesB f z0 h = go z0+ where+ go !z = do+ eof <- hIsEOF h+ if eof+ then return z+ else do+ l <- B.hGetLine h+ let z' = f z l in go z'+{-# INLINE foldLinesB #-}
+ benchmarks/haskell/Benchmarks/Pure.hs view
@@ -0,0 +1,474 @@+-- | Benchmarks various pure functions from the Text library+--+-- Tested in this benchmark:+--+-- * Most pure functions defined the string types+--+{-# LANGUAGE BangPatterns, GADTs, MagicHash #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Benchmarks.Pure+ ( benchmark+ ) where++import Control.DeepSeq (NFData (..))+import Control.Exception (evaluate)+import Criterion (Benchmark, bgroup, bench, nf)+import Data.Char (toLower, toUpper)+import Data.Monoid (mappend, mempty)+import GHC.Base (Char (..), Int (..), chr#, ord#, (+#))+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy.Char8 as BL+import qualified Data.ByteString.Lazy.Internal as BL+import qualified Data.ByteString.UTF8 as UTF8+import qualified Data.List as L+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Builder as TB+import qualified Data.Text.Lazy.Encoding as TL++benchmark :: FilePath -> IO Benchmark+benchmark fp = do+ -- Evaluate stuff before actually running the benchmark, we don't want to+ -- count it here.++ -- ByteString A+ bsa <- BS.readFile fp++ -- Text A/B, LazyText A/B+ ta <- evaluate $ T.decodeUtf8 bsa+ tb <- evaluate $ T.toUpper ta+ tla <- evaluate $ TL.fromChunks (T.chunksOf 16376 ta)+ tlb <- evaluate $ TL.fromChunks (T.chunksOf 16376 tb)++ -- ByteString B, LazyByteString A/B+ bsb <- evaluate $ T.encodeUtf8 tb+ bla <- evaluate $ BL.fromChunks (chunksOf 16376 bsa)+ blb <- evaluate $ BL.fromChunks (chunksOf 16376 bsb)++ -- String A/B+ sa <- evaluate $ UTF8.toString bsa+ sb <- evaluate $ T.unpack tb++ -- Lengths+ bsa_len <- evaluate $ BS.length bsa+ ta_len <- evaluate $ T.length ta+ bla_len <- evaluate $ BL.length bla+ tla_len <- evaluate $ TL.length tla+ sa_len <- evaluate $ L.length sa++ -- Lines+ bsl <- evaluate $ BS.lines bsa+ bll <- evaluate $ BL.lines bla+ tl <- evaluate $ T.lines ta+ tll <- evaluate $ TL.lines tla+ sl <- evaluate $ L.lines sa++ return $ bgroup "Pure"+ [ bgroup "append"+ [ benchT $ nf (T.append tb) ta+ , benchTL $ nf (TL.append tlb) tla+ , benchBS $ nf (BS.append bsb) bsa+ , benchBSL $ nf (BL.append blb) bla+ , benchS $ nf ((++) sb) sa+ ]+ , bgroup "concat"+ [ benchT $ nf T.concat tl+ , benchTL $ nf TL.concat tll+ , benchBS $ nf BS.concat bsl+ , benchBSL $ nf BL.concat bll+ , benchS $ nf L.concat sl+ ]+ , bgroup "cons"+ [ benchT $ nf (T.cons c) ta+ , benchTL $ nf (TL.cons c) tla+ , benchBS $ nf (BS.cons c) bsa+ , benchBSL $ nf (BL.cons c) bla+ , benchS $ nf (c:) sa+ ]+ , bgroup "concatMap"+ [ benchT $ nf (T.concatMap (T.replicate 3 . T.singleton)) ta+ , benchTL $ nf (TL.concatMap (TL.replicate 3 . TL.singleton)) tla+ , benchBS $ nf (BS.concatMap (BS.replicate 3)) bsa+ , benchBSL $ nf (BL.concatMap (BL.replicate 3)) bla+ , benchS $ nf (L.concatMap (L.replicate 3 . (:[]))) sa+ ]+ , bgroup "decode"+ [ benchT $ nf T.decodeUtf8 bsa+ , benchTL $ nf TL.decodeUtf8 bla+ , benchBS $ nf BS.unpack bsa+ , benchBSL $ nf BL.unpack bla+ , benchS $ nf UTF8.toString bsa+ ]+ , bgroup "drop"+ [ benchT $ nf (T.drop (ta_len `div` 3)) ta+ , benchTL $ nf (TL.drop (tla_len `div` 3)) tla+ , benchBS $ nf (BS.drop (bsa_len `div` 3)) bsa+ , benchBSL $ nf (BL.drop (bla_len `div` 3)) bla+ , benchS $ nf (L.drop (sa_len `div` 3)) sa+ ]+ , bgroup "encode"+ [ benchT $ nf T.encodeUtf8 ta+ , benchTL $ nf TL.encodeUtf8 tla+ , benchBS $ nf BS.pack sa+ , benchBSL $ nf BL.pack sa+ , benchS $ nf UTF8.fromString sa+ ]+ , bgroup "filter"+ [ benchT $ nf (T.filter p0) ta+ , benchTL $ nf (TL.filter p0) tla+ , benchBS $ nf (BS.filter p0) bsa+ , benchBSL $ nf (BL.filter p0) bla+ , benchS $ nf (L.filter p0) sa+ ]+ , bgroup "filter.filter"+ [ benchT $ nf (T.filter p1 . T.filter p0) ta+ , benchTL $ nf (TL.filter p1 . TL.filter p0) tla+ , benchBS $ nf (BS.filter p1 . BS.filter p0) bsa+ , benchBSL $ nf (BL.filter p1 . BL.filter p0) bla+ , benchS $ nf (L.filter p1 . L.filter p0) sa+ ]+ , bgroup "foldl'"+ [ benchT $ nf (T.foldl' len 0) ta+ , benchTL $ nf (TL.foldl' len 0) tla+ , benchBS $ nf (BS.foldl' len 0) bsa+ , benchBSL $ nf (BL.foldl' len 0) bla+ , benchS $ nf (L.foldl' len 0) sa+ ]+ , bgroup "foldr"+ [ benchT $ nf (L.length . T.foldr (:) []) ta+ , benchTL $ nf (L.length . TL.foldr (:) []) tla+ , benchBS $ nf (L.length . BS.foldr (:) []) bsa+ , benchBSL $ nf (L.length . BL.foldr (:) []) bla+ , benchS $ nf (L.length . L.foldr (:) []) sa+ ]+ , bgroup "head"+ [ benchT $ nf T.head ta+ , benchTL $ nf TL.head tla+ , benchBS $ nf BS.head bsa+ , benchBSL $ nf BL.head bla+ , benchS $ nf L.head sa+ ]+ , bgroup "init"+ [ benchT $ nf T.init ta+ , benchTL $ nf TL.init tla+ , benchBS $ nf BS.init bsa+ , benchBSL $ nf BL.init bla+ , benchS $ nf L.init sa+ ]+ , bgroup "intercalate"+ [ benchT $ nf (T.intercalate tsw) tl+ , benchTL $ nf (TL.intercalate tlw) tll+ , benchBS $ nf (BS.intercalate bsw) bsl+ , benchBSL $ nf (BL.intercalate blw) bll+ , benchS $ nf (L.intercalate lw) sl+ ]+ , bgroup "intersperse"+ [ benchT $ nf (T.intersperse c) ta+ , benchTL $ nf (TL.intersperse c) tla+ , benchBS $ nf (BS.intersperse c) bsa+ , benchBSL $ nf (BL.intersperse c) bla+ , benchS $ nf (L.intersperse c) sa+ ]+ , bgroup "isInfixOf"+ [ benchT $ nf (T.isInfixOf tsw) ta+ , benchTL $ nf (TL.isInfixOf tlw) tla+ , benchBS $ nf (BS.isInfixOf bsw) bsa+ -- no isInfixOf for lazy bytestrings+ , benchS $ nf (L.isInfixOf lw) sa+ ]+ , bgroup "last"+ [ benchT $ nf T.last ta+ , benchTL $ nf TL.last tla+ , benchBS $ nf BS.last bsa+ , benchBSL $ nf BL.last bla+ , benchS $ nf L.last sa+ ]+ , bgroup "map"+ [ benchT $ nf (T.map f) ta+ , benchTL $ nf (TL.map f) tla+ , benchBS $ nf (BS.map f) bsa+ , benchBSL $ nf (BL.map f) bla+ , benchS $ nf (L.map f) sa+ ]+ , bgroup "mapAccumL"+ [ benchT $ nf (T.mapAccumL g 0) ta+ , benchTL $ nf (TL.mapAccumL g 0) tla+ , benchBS $ nf (BS.mapAccumL g 0) bsa+ , benchBSL $ nf (BL.mapAccumL g 0) bla+ , benchS $ nf (L.mapAccumL g 0) sa+ ]+ , bgroup "mapAccumR"+ [ benchT $ nf (T.mapAccumR g 0) ta+ , benchTL $ nf (TL.mapAccumR g 0) tla+ , benchBS $ nf (BS.mapAccumR g 0) bsa+ , benchBSL $ nf (BL.mapAccumR g 0) bla+ , benchS $ nf (L.mapAccumR g 0) sa+ ]+ , bgroup "map.map"+ [ benchT $ nf (T.map f . T.map f) ta+ , benchTL $ nf (TL.map f . TL.map f) tla+ , benchBS $ nf (BS.map f . BS.map f) bsa+ , benchBSL $ nf (BL.map f . BL.map f) bla+ , benchS $ nf (L.map f . L.map f) sa+ ]+ , bgroup "replicate char"+ [ benchT $ nf (T.replicate bsa_len) (T.singleton c)+ , benchTL $ nf (TL.replicate (fromIntegral bsa_len)) (TL.singleton c)+ , benchBS $ nf (BS.replicate bsa_len) c+ , benchBSL $ nf (BL.replicate (fromIntegral bsa_len)) c+ , benchS $ nf (L.replicate bsa_len) c+ ]+ , bgroup "replicate string"+ [ benchT $ nf (T.replicate (bsa_len `div` T.length tsw)) tsw+ , benchTL $ nf (TL.replicate (fromIntegral bsa_len `div` TL.length tlw)) tlw+ , benchS $ nf (replicat (bsa_len `div` T.length tsw)) lw+ ]+ , bgroup "reverse"+ [ benchT $ nf T.reverse ta+ , benchTL $ nf TL.reverse tla+ , benchBS $ nf BS.reverse bsa+ , benchBSL $ nf BL.reverse bla+ , benchS $ nf L.reverse sa+ ]+ , bgroup "take"+ [ benchT $ nf (T.take (ta_len `div` 3)) ta+ , benchTL $ nf (TL.take (tla_len `div` 3)) tla+ , benchBS $ nf (BS.take (bsa_len `div` 3)) bsa+ , benchBSL $ nf (BL.take (bla_len `div` 3)) bla+ , benchS $ nf (L.take (sa_len `div` 3)) sa+ ]+ , bgroup "tail"+ [ benchT $ nf T.tail ta+ , benchTL $ nf TL.tail tla+ , benchBS $ nf BS.tail bsa+ , benchBSL $ nf BL.tail bla+ , benchS $ nf L.tail sa+ ]+ , bgroup "toLower"+ [ benchT $ nf T.toLower ta+ , benchTL $ nf TL.toLower tla+ , benchBS $ nf (BS.map toLower) bsa+ , benchBSL $ nf (BL.map toLower) bla+ , benchS $ nf (L.map toLower) sa+ ]+ , bgroup "toUpper"+ [ benchT $ nf T.toUpper ta+ , benchTL $ nf TL.toUpper tla+ , benchBS $ nf (BS.map toUpper) bsa+ , benchBSL $ nf (BL.map toUpper) bla+ , benchS $ nf (L.map toUpper) sa+ ]+ , bgroup "words"+ [ benchT $ nf T.words ta+ , benchTL $ nf TL.words tla+ , benchBS $ nf BS.words bsa+ , benchBSL $ nf BL.words bla+ , benchS $ nf L.words sa+ ]+ , bgroup "zipWith"+ [ benchT $ nf (T.zipWith min tb) ta+ , benchTL $ nf (TL.zipWith min tlb) tla+ , benchBS $ nf (BS.zipWith min bsb) bsa+ , benchBSL $ nf (BL.zipWith min blb) bla+ , benchS $ nf (L.zipWith min sb) sa+ ]+ , bgroup "length"+ [ bgroup "cons"+ [ benchT $ nf (T.length . T.cons c) ta+ , benchTL $ nf (TL.length . TL.cons c) tla+ , benchBS $ nf (BS.length . BS.cons c) bsa+ , benchBSL $ nf (BL.length . BL.cons c) bla+ , benchS $ nf (L.length . (:) c) sa+ ]+ , bgroup "decode"+ [ benchT $ nf (T.length . T.decodeUtf8) bsa+ , benchTL $ nf (TL.length . TL.decodeUtf8) bla+ , benchBS $ nf (L.length . BS.unpack) bsa+ , benchBSL $ nf (L.length . BL.unpack) bla+ , bench "StringUTF8" $ nf (L.length . UTF8.toString) bsa+ ]+ , bgroup "drop"+ [ benchT $ nf (T.length . T.drop (ta_len `div` 3)) ta+ , benchTL $ nf (TL.length . TL.drop (tla_len `div` 3)) tla+ , benchBS $ nf (BS.length . BS.drop (bsa_len `div` 3)) bsa+ , benchBSL $ nf (BL.length . BL.drop (bla_len `div` 3)) bla+ , benchS $ nf (L.length . L.drop (sa_len `div` 3)) sa+ ]+ , bgroup "filter"+ [ benchT $ nf (T.length . T.filter p0) ta+ , benchTL $ nf (TL.length . TL.filter p0) tla+ , benchBS $ nf (BS.length . BS.filter p0) bsa+ , benchBSL $ nf (BL.length . BL.filter p0) bla+ , benchS $ nf (L.length . L.filter p0) sa+ ]+ , bgroup "filter.filter"+ [ benchT $ nf (T.length . T.filter p1 . T.filter p0) ta+ , benchTL $ nf (TL.length . TL.filter p1 . TL.filter p0) tla+ , benchBS $ nf (BS.length . BS.filter p1 . BS.filter p0) bsa+ , benchBSL $ nf (BL.length . BL.filter p1 . BL.filter p0) bla+ , benchS $ nf (L.length . L.filter p1 . L.filter p0) sa+ ]+ , bgroup "init"+ [ benchT $ nf (T.length . T.init) ta+ , benchTL $ nf (TL.length . TL.init) tla+ , benchBS $ nf (BS.length . BS.init) bsa+ , benchBSL $ nf (BL.length . BL.init) bla+ , benchS $ nf (L.length . L.init) sa+ ]+ , bgroup "intercalate"+ [ benchT $ nf (T.length . T.intercalate tsw) tl+ , benchTL $ nf (TL.length . TL.intercalate tlw) tll+ , benchBS $ nf (BS.length . BS.intercalate bsw) bsl+ , benchBSL $ nf (BL.length . BL.intercalate blw) bll+ , benchS $ nf (L.length . L.intercalate lw) sl+ ]+ , bgroup "intersperse"+ [ benchT $ nf (T.length . T.intersperse c) ta+ , benchTL $ nf (TL.length . TL.intersperse c) tla+ , benchBS $ nf (BS.length . BS.intersperse c) bsa+ , benchBSL $ nf (BL.length . BL.intersperse c) bla+ , benchS $ nf (L.length . L.intersperse c) sa+ ]+ , bgroup "map"+ [ benchT $ nf (T.length . T.map f) ta+ , benchTL $ nf (TL.length . TL.map f) tla+ , benchBS $ nf (BS.length . BS.map f) bsa+ , benchBSL $ nf (BL.length . BL.map f) bla+ , benchS $ nf (L.length . L.map f) sa+ ]+ , bgroup "map.map"+ [ benchT $ nf (T.length . T.map f . T.map f) ta+ , benchTL $ nf (TL.length . TL.map f . TL.map f) tla+ , benchBS $ nf (BS.length . BS.map f . BS.map f) bsa+ , benchS $ nf (L.length . L.map f . L.map f) sa+ ]+ , bgroup "replicate char"+ [ benchT $ nf (T.length . T.replicate bsa_len) (T.singleton c)+ , benchTL $ nf (TL.length . TL.replicate (fromIntegral bsa_len)) (TL.singleton c)+ , benchBS $ nf (BS.length . BS.replicate bsa_len) c+ , benchBSL $ nf (BL.length . BL.replicate (fromIntegral bsa_len)) c+ , benchS $ nf (L.length . L.replicate bsa_len) c+ ]+ , bgroup "replicate string"+ [ benchT $ nf (T.length . T.replicate (bsa_len `div` T.length tsw)) tsw+ , benchTL $ nf (TL.length . TL.replicate (fromIntegral bsa_len `div` TL.length tlw)) tlw+ , benchS $ nf (L.length . replicat (bsa_len `div` T.length tsw)) lw+ ]+ , bgroup "take"+ [ benchT $ nf (T.length . T.take (ta_len `div` 3)) ta+ , benchTL $ nf (TL.length . TL.take (tla_len `div` 3)) tla+ , benchBS $ nf (BS.length . BS.take (bsa_len `div` 3)) bsa+ , benchBSL $ nf (BL.length . BL.take (bla_len `div` 3)) bla+ , benchS $ nf (L.length . L.take (sa_len `div` 3)) sa+ ]+ , bgroup "tail"+ [ benchT $ nf (T.length . T.tail) ta+ , benchTL $ nf (TL.length . TL.tail) tla+ , benchBS $ nf (BS.length . BS.tail) bsa+ , benchBSL $ nf (BL.length . BL.tail) bla+ , benchS $ nf (L.length . L.tail) sa+ ]+ , bgroup "toLower"+ [ benchT $ nf (T.length . T.toLower) ta+ , benchTL $ nf (TL.length . TL.toLower) tla+ , benchBS $ nf (BS.length . BS.map toLower) bsa+ , benchBSL $ nf (BL.length . BL.map toLower) bla+ , benchS $ nf (L.length . L.map toLower) sa+ ]+ , bgroup "toUpper"+ [ benchT $ nf (T.length . T.toUpper) ta+ , benchTL $ nf (TL.length . TL.toUpper) tla+ , benchBS $ nf (BS.length . BS.map toUpper) bsa+ , benchBSL $ nf (BL.length . BL.map toUpper) bla+ , benchS $ nf (L.length . L.map toUpper) sa+ ]+ , bgroup "words"+ [ benchT $ nf (L.length . T.words) ta+ , benchTL $ nf (L.length . TL.words) tla+ , benchBS $ nf (L.length . BS.words) bsa+ , benchBSL $ nf (L.length . BL.words) bla+ , benchS $ nf (L.length . L.words) sa+ ]+ , bgroup "zipWith"+ [ benchT $ nf (T.length . T.zipWith min tb) ta+ , benchTL $ nf (TL.length . TL.zipWith min tlb) tla+ , benchBS $ nf (L.length . BS.zipWith min bsb) bsa+ , benchBSL $ nf (L.length . BL.zipWith min blb) bla+ , benchS $ nf (L.length . L.zipWith min sb) sa+ ]+ ]+ , bgroup "Builder"+ [ bench "mappend char" $ nf (TL.length . TB.toLazyText . mappendNChar 'a') 10000+ , bench "mappend 8 char" $ nf (TL.length . TB.toLazyText . mappend8Char) 'a'+ , bench "mappend text" $ nf (TL.length . TB.toLazyText . mappendNText short) 10000+ ]+ ]+ where+ benchS = bench "String"+ benchT = bench "Text"+ benchTL = bench "LazyText"+ benchBS = bench "ByteString"+ benchBSL = bench "LazyByteString"++ c = 'й'+ p0 = (== c)+ p1 = (/= 'д')+ lw = "право"+ bsw = UTF8.fromString lw+ blw = BL.fromChunks [bsw]+ tsw = T.pack lw+ tlw = TL.fromChunks [tsw]+ f (C# c#) = C# (chr# (ord# c# +# 1#))+ g (I# i#) (C# c#) = (I# (i# +# 1#), C# (chr# (ord# c# +# i#)))+ len l _ = l + (1::Int)+ replicat n = concat . L.replicate n+ short = T.pack "short"++instance NFData BS.ByteString++instance NFData BL.ByteString where+ rnf BL.Empty = ()+ rnf (BL.Chunk _ ts) = rnf ts++data B where+ B :: NFData a => a -> B++instance NFData B where+ rnf (B b) = rnf b++-- | Split a bytestring in chunks+--+chunksOf :: Int -> BS.ByteString -> [BS.ByteString]+chunksOf k = go+ where+ go t = case BS.splitAt k t of+ (a,b) | BS.null a -> []+ | otherwise -> a : go b++-- | Append a character n times+--+mappendNChar :: Char -> Int -> TB.Builder+mappendNChar c n = go 0+ where+ go i+ | i < n = TB.singleton c `mappend` go (i+1)+ | otherwise = mempty++-- | Gives more opportunity for inlining and elimination of unnecesary+-- bounds checks.+--+mappend8Char :: Char -> TB.Builder+mappend8Char c = TB.singleton c `mappend` TB.singleton c `mappend`+ TB.singleton c `mappend` TB.singleton c `mappend`+ TB.singleton c `mappend` TB.singleton c `mappend`+ TB.singleton c `mappend` TB.singleton c++-- | Append a text N times+--+mappendNText :: T.Text -> Int -> TB.Builder+mappendNText t n = go 0+ where+ go i+ | i < n = TB.fromText t `mappend` go (i+1)+ | otherwise = mempty
+ benchmarks/haskell/Benchmarks/ReadNumbers.hs view
@@ -0,0 +1,96 @@+-- | Read numbers from a file with a just a number on each line, find the+-- minimum of those numbers. The file contains different kinds of numbers:+--+-- * Decimals+--+-- * Hexadecimals+--+-- * Floating point numbers+--+-- * Floating point numbers in scientific notation+--+-- The different benchmarks will only take into account the values they can+-- parse.+--+-- Tested in this benchmark:+--+-- * Lexing/parsing of different numerical types+--+module Benchmarks.ReadNumbers+ ( benchmark+ ) where++import Criterion (Benchmark, bgroup, bench, whnf)+import Data.List (foldl')+import Numeric (readDec, readFloat, readHex)+import qualified Data.ByteString.Char8 as B+import qualified Data.ByteString.Lazy.Char8 as BL+import qualified Data.ByteString.Lex.Double as B+import qualified Data.ByteString.Lex.Lazy.Double as BL+import qualified Data.Text as T+import qualified Data.Text.IO as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.IO as TL+import qualified Data.Text.Lazy.Read as TL+import qualified Data.Text.Read as T++benchmark :: FilePath -> IO Benchmark+benchmark fp = do+ -- Read all files into lines: string, text, lazy text, bytestring, lazy+ -- bytestring+ s <- lines `fmap` readFile fp+ t <- T.lines `fmap` T.readFile fp+ tl <- TL.lines `fmap` TL.readFile fp+ b <- B.lines `fmap` B.readFile fp+ bl <- BL.lines `fmap` BL.readFile fp+ return $ bgroup "ReadNumbers"+ [ bench "DecimalString" $ whnf (int . string readDec) s+ , bench "HexadecimalString" $ whnf (int . string readHex) s+ , bench "DoubleString" $ whnf (double . string readFloat) s++ , bench "DecimalText" $ whnf (int . text (T.signed T.decimal)) t+ , bench "HexadecimalText" $ whnf (int . text (T.signed T.hexadecimal)) t+ , bench "DoubleText" $ whnf (double . text T.double) t+ , bench "RationalText" $ whnf (double . text T.rational) t++ , bench "DecimalLazyText" $+ whnf (int . text (TL.signed TL.decimal)) tl+ , bench "HexadecimalLazyText" $+ whnf (int . text (TL.signed TL.hexadecimal)) tl+ , bench "DoubleLazyText" $+ whnf (double . text TL.double) tl+ , bench "RationalLazyText" $+ whnf (double . text TL.rational) tl++ , bench "DecimalByteString" $ whnf (int . byteString B.readInt) b+ , bench "DoubleByteString" $ whnf (double . byteString B.readDouble) b++ , bench "DecimalLazyByteString" $+ whnf (int . byteString BL.readInt) bl+ , bench "DoubleLazyByteString" $+ whnf (double . byteString BL.readDouble) bl+ ]+ where+ -- Used for fixing types+ int :: Int -> Int+ int = id+ double :: Double -> Double+ double = id++string :: (Ord a, Num a) => (t -> [(a, t)]) -> [t] -> a+string reader = foldl' go 1000000+ where+ go z t = case reader t of [(n, _)] -> min n z+ _ -> z++text :: (Ord a, Num a) => (t -> Either String (a,t)) -> [t] -> a+text reader = foldl' go 1000000+ where+ go z t = case reader t of Left _ -> z+ Right (n, _) -> min n z++byteString :: (Ord a, Num a) => (t -> Maybe (a,t)) -> [t] -> a+byteString reader = foldl' go 1000000+ where+ go z t = case reader t of Nothing -> z+ Just (n, _) -> min n z
+ benchmarks/haskell/Benchmarks/Replace.hs view
@@ -0,0 +1,31 @@+-- | Replace a string by another string+--+-- Tested in this benchmark:+--+-- * Search and replace of a pattern in a text+--+module Benchmarks.Replace+ ( benchmark+ ) where++import Criterion (Benchmark, bgroup, bench, nf)+import qualified Data.ByteString.Char8 as B+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy.Search as BL+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL+import qualified Data.Text.Lazy.IO as TL++benchmark :: FilePath -> String -> String -> IO Benchmark+benchmark fp pat sub = do+ tl <- TL.readFile fp+ bl <- BL.readFile fp+ return $ bgroup "Replace"+ [ bench "LazyText" $ nf (TL.length . TL.replace tpat tsub) tl+ , bench "LazyByteString" $ nf (BL.length . BL.replace bpat bsub) bl+ ]+ where+ tpat = TL.pack pat+ tsub = TL.pack sub+ bpat = B.concat $ BL.toChunks $ TL.encodeUtf8 tpat+ bsub = B.concat $ BL.toChunks $ TL.encodeUtf8 tsub
+ benchmarks/haskell/Benchmarks/Search.hs view
@@ -0,0 +1,48 @@+-- | Search for a pattern in a file, find the number of occurences+--+-- Tested in this benchmark:+--+-- * Searching all occurences of a pattern using library routines+--+module Benchmarks.Search+ ( benchmark+ ) where++import Criterion (Benchmark, bench, bgroup, whnf)+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy.Search as BL+import qualified Data.ByteString.Search as B+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.IO as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.IO as TL++benchmark :: FilePath -> T.Text -> IO Benchmark+benchmark fp needleT = do+ b <- B.readFile fp+ bl <- BL.readFile fp+ t <- T.readFile fp+ tl <- TL.readFile fp+ return $ bgroup "FileIndices"+ [ bench "ByteString" $ whnf (byteString needleB) b+ , bench "LazyByteString" $ whnf (lazyByteString needleB) bl+ , bench "Text" $ whnf (text needleT) t+ , bench "LazyText" $ whnf (lazyText needleTL) tl+ ]+ where+ needleB = T.encodeUtf8 needleT+ needleTL = TL.fromChunks [needleT]++byteString :: B.ByteString -> B.ByteString -> Int+byteString needle = length . B.indices needle++lazyByteString :: B.ByteString -> BL.ByteString -> Int+lazyByteString needle = length . BL.indices needle++text :: T.Text -> T.Text -> Int+text = T.count++lazyText :: TL.Text -> TL.Text -> Int+lazyText needle = fromIntegral . TL.count needle
+ benchmarks/haskell/Benchmarks/Stream.hs view
@@ -0,0 +1,94 @@+-- | This module contains a number of benchmarks for the different streaming+-- functions+--+-- Tested in this benchmark:+--+-- * Most streaming functions+--+{-# LANGUAGE BangPatterns #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Benchmarks.Stream+ ( benchmark+ ) where++import Control.DeepSeq (NFData (..))+import Criterion (Benchmark, bgroup, bench, nf)+import Data.Text.Fusion.Internal (Step (..), Stream (..))+import qualified Data.Text.Encoding as T+import qualified Data.Text.Encoding.Error as E+import qualified Data.Text.Encoding.Fusion as T+import qualified Data.Text.Encoding.Fusion.Common as F+import qualified Data.Text.Fusion as T+import qualified Data.Text.IO as T+import qualified Data.Text.Lazy.Encoding as TL+import qualified Data.Text.Lazy.Encoding.Fusion as TL+import qualified Data.Text.Lazy.Fusion as TL+import qualified Data.Text.Lazy.IO as TL++instance NFData a => NFData (Stream a) where+ -- Currently, this implementation does not force evaluation of the size hint+ rnf (Stream next s0 _) = go s0+ where+ go !s = case next s of+ Done -> ()+ Skip s' -> go s'+ Yield x s' -> rnf x `seq` go s'++benchmark :: FilePath -> IO Benchmark+benchmark fp = do+ -- Different formats+ t <- T.readFile fp+ let !utf8 = T.encodeUtf8 t+ !utf16le = T.encodeUtf16LE t+ !utf16be = T.encodeUtf16BE t+ !utf32le = T.encodeUtf32LE t+ !utf32be = T.encodeUtf32BE t++ -- Once again for the lazy variants+ tl <- TL.readFile fp+ let !utf8L = TL.encodeUtf8 tl+ !utf16leL = TL.encodeUtf16LE tl+ !utf16beL = TL.encodeUtf16BE tl+ !utf32leL = TL.encodeUtf32LE tl+ !utf32beL = TL.encodeUtf32BE tl++ -- For the functions which operate on streams+ let !s = T.stream t++ return $ bgroup "Stream"++ -- Fusion+ [ bgroup "stream" $+ [ bench "Text" $ nf T.stream t+ , bench "LazyText" $ nf TL.stream tl+ ]++ -- Encoding.Fusion+ , bgroup "streamUtf8"+ [ bench "Text" $ nf (T.streamUtf8 E.lenientDecode) utf8+ , bench "LazyText" $ nf (TL.streamUtf8 E.lenientDecode) utf8L+ ]+ , bgroup "streamUtf16LE"+ [ bench "Text" $ nf (T.streamUtf16LE E.lenientDecode) utf16le+ , bench "LazyText" $ nf (TL.streamUtf16LE E.lenientDecode) utf16leL+ ]+ , bgroup "streamUtf16BE"+ [ bench "Text" $ nf (T.streamUtf16BE E.lenientDecode) utf16be+ , bench "LazyText" $ nf (TL.streamUtf16BE E.lenientDecode) utf16beL+ ]+ , bgroup "streamUtf32LE"+ [ bench "Text" $ nf (T.streamUtf32LE E.lenientDecode) utf32le+ , bench "LazyText" $ nf (TL.streamUtf32LE E.lenientDecode) utf32leL+ ]+ , bgroup "streamUtf32BE"+ [ bench "Text" $ nf (T.streamUtf32BE E.lenientDecode) utf32be+ , bench "LazyText" $ nf (TL.streamUtf32BE E.lenientDecode) utf32beL+ ]++ -- Encoding.Fusion.Common+ , bench "restreamUtf8" $ nf F.restreamUtf8 s+ , bench "restreamUtf16LE" $ nf F.restreamUtf16LE s+ , bench "restreamUtf16BE" $ nf F.restreamUtf16BE s+ , bench "restreamUtf32LE" $ nf F.restreamUtf32LE s+ , bench "restreamUtf32BE" $ nf F.restreamUtf32BE s+ ]
+ benchmarks/haskell/Benchmarks/WordFrequencies.hs view
@@ -0,0 +1,36 @@+-- | A word frequency count using the different string types+--+-- Tested in this benchmark:+--+-- * Splitting into words+--+-- * Converting to lowercase+--+-- * Comparing: Eq/Ord instances+--+module Benchmarks.WordFrequencies+ ( benchmark+ ) where++import Criterion (Benchmark, bench, bgroup, whnf)+import Data.Char (toLower)+import Data.List (foldl')+import Data.Map (Map)+import qualified Data.ByteString.Char8 as B+import qualified Data.Map as M+import qualified Data.Text as T+import qualified Data.Text.IO as T++benchmark :: FilePath -> IO Benchmark+benchmark fp = do+ s <- readFile fp+ b <- B.readFile fp+ t <- T.readFile fp+ return $ bgroup "WordFrequencies"+ [ bench "String" $ whnf (frequencies . words . map toLower) s+ , bench "ByteString" $ whnf (frequencies . B.words . B.map toLower) b+ , bench "Text" $ whnf (frequencies . T.words . T.toLower) t+ ]++frequencies :: Ord a => [a] -> Map a Int+frequencies = foldl' (\m k -> M.insertWith (+) k 1 m) M.empty
+ benchmarks/haskell/Multilang.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE BangPatterns, OverloadedStrings, RankNTypes #-}++module Main (+ main+ ) where++import Control.Monad (forM_)+import qualified Data.ByteString as B+import qualified Data.Text as Text+import Data.Text.Encoding (decodeUtf8)+import Data.Text (Text)+import System.IO (hFlush, stdout)+import Timer (timer)++type BM = Text -> ()++bm :: forall a. (Text -> a) -> BM+bm f t = f t `seq` ()++benchmarks :: [(String, Text.Text -> ())]+benchmarks = [+ ("find_first", bm $ Text.isInfixOf "en:Benin")+ , ("find_index", bm $ Text.findIndex (=='c'))+ ]++main :: IO ()+main = do+ !contents <- decodeUtf8 `fmap` B.readFile "../tests/text-test-data/yiwiki.xml"+ forM_ benchmarks $ \(name, bmark) -> do+ putStr $ name ++ " "+ hFlush stdout+ putStrLn =<< (timer 100 contents bmark)
+ benchmarks/haskell/Timer.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE BangPatterns #-}++module Timer (timer) where++import Control.Exception (evaluate)+import Data.Time.Clock.POSIX (getPOSIXTime)+import GHC.Float (FFFormat(..), formatRealFloat)++ickyRound :: Int -> Double -> String+ickyRound k = formatRealFloat FFFixed (Just k)++timer :: Int -> a -> (a -> b) -> IO String+timer count a0 f = do+ let loop !k !fastest+ | k <= 0 = return fastest+ | otherwise = do+ start <- getPOSIXTime+ let inner a i+ | i <= 0 = return ()+ | otherwise = evaluate (f a) >> inner a (i-1)+ inner a0 count+ end <- getPOSIXTime+ let elapsed = end - start+ loop (k-1) (min fastest (elapsed / fromIntegral count))+ t <- loop (3::Int) 1e300+ let log10 x = log x / log 10+ ft = realToFrac t+ prec = round (log10 (fromIntegral count) - log10 ft)+ return $! ickyRound prec ft+{-# NOINLINE timer #-}
+ benchmarks/python/cut.py view
@@ -0,0 +1,12 @@+#!/usr/bin/env python++import utils, sys, codecs++def cut(filename, l, r):+ content = open(filename, encoding='utf-8')+ for line in content:+ print(line[l:r])++for f in sys.argv[1:]:+ t = utils.benchmark(lambda: cut(f, 20, 40))+ sys.stderr.write('{0}: {1}\n'.format(f, t))
+ benchmarks/python/multilang.py view
@@ -0,0 +1,50 @@+#!/usr/bin/env python++import math+import sys+import time++def find_first():+ cf = contents.find+ return timer(lambda: cf("en:Benin"))++def timer(f, count=100):+ a = 1e300+ def g():+ return+ for i in xrange(3):+ start = time.time()+ for j in xrange(count):+ g()+ a = min(a, (time.time() - start) / count)++ b = 1e300+ for i in xrange(3):+ start = time.time()+ for j in xrange(count):+ f()+ b = min(b, (time.time() - start) / count)++ return round(b - a, int(round(math.log(count, 10) - math.log(b - a, 10))))++contents = open('../../tests/text-test-data/yiwiki.xml', 'r').read()+contents = contents.decode('utf-8')++benchmarks = (+ find_first,+ )++to_run = sys.argv[1:]+bms = []+if to_run:+ for r in to_run:+ for b in benchmarks:+ if b.__name__.startswith(r):+ bms.append(b)+else:+ bms = benchmarks++for b in bms:+ sys.stdout.write(b.__name__ + ' ')+ sys.stdout.flush()+ print b()
+ benchmarks/python/sort.py view
@@ -0,0 +1,13 @@+#!/usr/bin/env python++import utils, sys, codecs++def sort(filename):+ content = open(filename, encoding='utf-8').read()+ lines = content.splitlines()+ lines.sort()+ print('\n'.join(lines))++for f in sys.argv[1:]:+ t = utils.benchmark(lambda: sort(f))+ sys.stderr.write('{0}: {1}\n'.format(f, t))
+ benchmarks/python/strip_tags.py view
@@ -0,0 +1,25 @@+#!/usr/bin/env python++import utils, sys++def strip_tags(filename):+ string = open(filename, encoding='utf-8').read()++ d = 0+ out = []++ for c in string:+ if c == '<': d += 1++ if d > 0:+ out += ' '+ else:+ out += c++ if c == '>': d -= 1++ print(''.join(out))++for f in sys.argv[1:]:+ t = utils.benchmark(lambda: strip_tags(f))+ sys.stderr.write('{0}: {1}\n'.format(f, t))
+ benchmarks/python/utils.py view
@@ -0,0 +1,18 @@+#!/usr/bin/env python++import sys, time++def benchmark_once(f):+ start = time.time()+ f()+ end = time.time()+ return end - start++def benchmark(f):+ runs = 100+ total = 0.0+ for i in range(runs):+ result = benchmark_once(f)+ sys.stderr.write('Run {0}: {1}\n'.format(i, result))+ total += result+ return total / runs
+ benchmarks/ruby/cut.rb view
@@ -0,0 +1,16 @@+#!/usr/bin/env ruby++require './utils.rb'++def cut(filename, l, r)+ File.open(filename, 'r:utf-8') do |file|+ file.each_line do |line|+ puts line[l, r - l]+ end+ end+end++ARGV.each do |f|+ t = benchmark { cut(f, 20, 40) }+ STDERR.puts "#{f}: #{t}"+end
+ benchmarks/ruby/fold.rb view
@@ -0,0 +1,50 @@+#!/usr/bin/env ruby++require './utils.rb'++def fold(filename, max_width)+ File.open(filename, 'r:utf-8') do |file|+ # Words in this paragraph+ paragraph = []++ file.each_line do |line|+ # If we encounter an empty line, we reformat and dump the current+ # paragraph+ if line.strip.empty?+ puts fold_paragraph(paragraph, max_width)+ puts+ paragraph = []+ # Otherwise, we append the words found in the line to the paragraph+ else+ paragraph.concat line.split+ end+ end++ # Last paragraph+ puts fold_paragraph(paragraph, max_width) unless paragraph.empty?+ end+end++# Fold a single paragraph to the desired width+def fold_paragraph(paragraph, max_width)+ # Gradually build our output+ str, *rest = paragraph+ width = str.length++ rest.each do |word|+ if width + word.length + 1 <= max_width+ str << ' ' << word+ width += word.length + 1+ else+ str << "\n" << word+ width = word.length+ end+ end++ str+end++ARGV.each do |f|+ t = benchmark { fold(f, 80) }+ STDERR.puts "#{f}: #{t}"+end
+ benchmarks/ruby/sort.rb view
@@ -0,0 +1,15 @@+#!/usr/bin/env ruby++require './utils.rb'++def sort(filename)+ File.open(filename, 'r:utf-8') do |file|+ content = file.read+ puts content.lines.sort.join+ end+end++ARGV.each do |f|+ t = benchmark { sort(f) }+ STDERR.puts "#{f}: #{t}"+end
+ benchmarks/ruby/strip_tags.rb view
@@ -0,0 +1,22 @@+#!/usr/bin/env ruby++require './utils.rb'++def strip_tags(filename)+ File.open(filename, 'r:utf-8') do |file|+ str = file.read++ d = 0++ str.each_char do |c|+ d += 1 if c == '<'+ putc(if d > 0 then ' ' else c end)+ d -= 1 if c == '>'+ end+ end+end++ARGV.each do |f|+ t = benchmark { strip_tags(f) }+ STDERR.puts "#{f}: #{t}"+end
+ benchmarks/ruby/utils.rb view
@@ -0,0 +1,14 @@+require 'benchmark'++def benchmark(&block)+ runs = 100+ total = 0++ runs.times do |i|+ result = Benchmark.measure(&block).total+ $stderr.puts "Run #{i}: #{result}"+ total += result+ end++ total / runs +end
+ benchmarks/text-benchmarks.cabal view
@@ -0,0 +1,46 @@+name: text-benchmarks+version: 0.0.0.0+synopsis: Benchmarks for the text package+description: Benchmarks for the text package+homepage: https://bitbucket.org/bos/text+license: BSD3+license-file: ../LICENSE+author: Jasper Van der Jeugt <jaspervdj@gmail.com>,+ Bryan O'Sullivan <bos@serpentine.com>,+ Tom Harper <rtomharper@googlemail.com>,+ Duncan Coutts <duncan@haskell.org>+maintainer: jaspervdj@gmail.com+category: Text+build-type: Simple++cabal-version: >=1.2++executable text-benchmarks+ hs-source-dirs: haskell ..+ c-sources: ../cbits/cbits.c+ cbits/time_iconv.c+ main-is: Benchmarks.hs+ ghc-options: -Wall -O2 -fllvm+ cpp-options: -DHAVE_DEEPSEQ+ build-depends: base == 4.*,+ binary,+ blaze-builder,+ bytestring,+ bytestring-lexing,+ containers,+ criterion >= 0.6.0.1,+ deepseq,+ directory,+ filepath,+ ghc-prim,+ stringsearch,+ utf8-string++executable text-multilang+ hs-source-dirs: haskell+ main-is: Multilang.hs+ ghc-options: -Wall -O2 -fllvm+ build-depends: base == 4.*,+ bytestring,+ text,+ time
cbits/cbits.c view
@@ -47,7 +47,7 @@ 12, 0,12,12,12,12,12, 0,12, 0,12,12, 12,24,12,12,12,12,12,24,12,24,12,12, 12,12,12,12,12,12,12,24,12,12,12,12, 12,24,12,12,12,12,12,12,12,24,12,12, 12,12,12,12,12,12,12,36,12,36,12,12, 12,36,12,12,12,12,12,36,12,36,12,12,- 12,36,12,12,12,12,12,12,12,12,12,12, + 12,36,12,12,12,12,12,12,12,12,12,12, }; static inline uint32_t
scripts/Arsec.hs view
@@ -26,7 +26,7 @@ instance Applicative (GenParser s a) where pure = return (<*>) = ap- + instance Alternative (GenParser s a) where empty = mzero (<|>) = mplus
+ tests-and-benchmarks.markdown view
@@ -0,0 +1,63 @@+Tests and benchmarks+====================++Prerequisites+-------------++To run the tests and benchmarks, you will need the test data, which+you can clone from one of the following locations:++* Mercurial master repository:+ [bitbucket.org/bos/text-test-data](https://bitbucket.org/bos/text-test-data)++* Git mirror repository:+ [github.com/bos/text-test-data](https://github.com/bos/text-test-data)++You should clone that repository into the `tests` subdirectory (your+clone must be named `text-test-data` locally), then run `make -C+tests/text-test-data` to uncompress the test files. Many tests and+benchmarks will fail if the test files are missing.++Functional tests+----------------++The functional tests are located in the `tests` subdirectory. An overview of+what's in that directory:++ Makefile Has targets for common tasks+ Tests Source files of the testing code+ scripts Various utility scripts+ text-tests.cabal Cabal file that compiles all benchmarks++The `text-tests.cabal` builds:++- A copy of the text library, sharing the source code, but exposing all internal+ modules, for testing purposes+- The different test suites++To compile, run all tests, and generate a coverage report, simply use `make`.++Benchmarks+----------++The benchmarks are located in the `benchmarks` subdirectory. An overview of+what's in that directory:++ Makefile Has targets for common tasks+ haskell Source files of the haskell benchmarks+ python Python implementations of some benchmarks+ ruby Ruby implementations of some benchmarks+ text-benchmarks.cabal Cabal file which compiles all benchmarks++To compile the benchmarks, navigate to the `benchmarks` subdirectory and run+`cabal configure && cabal build`. Then, you can run the benchmarks using:++ ./dist/build/text-benchmarks/text-benchmarks++However, since there's quite a lot of benchmarks, you usually don't want to+run them all. Instead, use the `-l` flag to get a list of benchmarks:++ ./dist/build/text-benchmarks/text-benchmarks++And run the ones you want to inspect. If you want to configure the benchmarks+further, the exact parameters can be changed in `Benchmarks.hs`.
+ tests/.ghci view
@@ -0,0 +1,1 @@+:set -DHAVE_DEEPSEQ -isrc -i../..
+ tests/Makefile view
@@ -0,0 +1,35 @@+count = 1000++coverage: build coverage/hpc_index.html++build: text-test-data+ cabal configure -fhpc+ cabal build++text-test-data:+ hg clone https://bitbucket.org/bos/text-test-data+ $(MAKE) -C text-test-data++coverage/text-tests.tix:+ -mkdir -p coverage+ ./dist/build/text-tests/text-tests -a $(count)+ mv text-tests.tix $@++coverage/text-tests-stdio.tix:+ -mkdir -p coverage+ ./scripts/cover-stdio.sh ./dist/build/text-tests-stdio/text-tests-stdio+ mv text-tests-stdio.tix $@++coverage/coverage.tix: coverage/text-tests.tix coverage/text-tests-stdio.tix+ hpc combine --output=$@ \+ --exclude=Main \+ coverage/text-tests.tix \+ coverage/text-tests-stdio.tix++coverage/hpc_index.html: coverage/coverage.tix+ hpc markup --destdir=coverage coverage/coverage.tix++clean:+ rm -rf dist coverage .hpc++.PHONY: build coverage
− tests/README.markdown
@@ -1,63 +0,0 @@-Tests-=====--This directory contains the tests for the Text library. To run these-tests, you will need the test data from one of the following-locations:--* Mercurial master repository:- [bitbucket.org/bos/text-test-data](https://bitbucket.org/bos/text-test-data)--* Git mirror repository:- [github.com/bos/text-test-data](https://github.com/bos/text-test-data)--You should clone that repository to the same directory as this `README`-file, then run `make` to uncompress the test files. Many tests will-fail if the test files are missing.--There are two categories of tests: functional tests (including QuickCheck-properties), and benchmarks.--Functional tests-------------------The functional tests are located in the `tests` subdirectory. An overview of-what's in that directory:-- scripts Various utility scripts- src Source files of the testing code- text-tests.cabal Cabal file which compiles all benchmarks- Makefile Has targets for common tasks--The `text-tests.cabal` builds:--- A copy of the text library, sharing the source code, but exposing all internal- modules, for testing purposes-- The different test suites--To compile, run all tests, and generate a coverage report, simply use `make`.--Benchmarks-------------The benchmarks are located in the `benchmarks` subdirectory. An overview of-what's in that directory:-- python Python implementations of some benchmarks- ruby Ruby implementations of some benchmarks- src Source files of the haskell benchmarks- benchmarks.cabal Cabal file which compiles all benchmarks- Makefile Has targets for common tasks--To compile the benchmarks, navigate to the `benchmarks` subdirectory and run-`cabal configure && cabal build`. Then, you can run the benchmarks using:-- ./dist/build/benchmarks/benchmarks--However, since there quite a lot of benchmarks, you usually don't want to run-them all. Instead, use the `-l` flag to get a list of benchmarks:-- ./dist/build/benchmarks/benchmarks--And run the ones you want to inspect. If you want to configure the benchmarks-further, the exact parameters can be changed in `src/Data/Text/Benchmarks.hs`.
+ tests/Tests.hs view
@@ -0,0 +1,13 @@+-- | Provides a simple main function which runs all the tests+--+module Main+ ( main+ ) where++import Test.Framework (defaultMain)++import qualified Tests.Properties as Properties+import qualified Tests.Regressions as Regressions++main :: IO ()+main = defaultMain [Properties.tests, Regressions.tests]
+ tests/Tests/IO.hs view
@@ -0,0 +1,34 @@+-- | Program which exposes some haskell functions as an exutable. The results+-- and coverage of this module is meant to be checked using a shell script.+--+module Main+ (+ main+ ) where++import System.Environment (getArgs)+import System.Exit (exitFailure)+import System.IO (hPutStrLn, stderr)+import qualified Data.Text as T+import qualified Data.Text.IO as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.IO as TL++main :: IO ()+main = do+ args <- getArgs+ case args of+ ["T.readFile", name] -> T.putStr =<< T.readFile name+ ["T.writeFile", name, t] -> T.writeFile name (T.pack t)+ ["T.appendFile", name, t] -> T.appendFile name (T.pack t)+ ["T.interact"] -> T.interact id+ ["T.getContents"] -> T.putStr =<< T.getContents+ ["T.getLine"] -> T.putStrLn =<< T.getLine++ ["TL.readFile", name] -> TL.putStr =<< TL.readFile name+ ["TL.writeFile", name, t] -> TL.writeFile name (TL.pack t)+ ["TL.appendFile", name, t] -> TL.appendFile name (TL.pack t)+ ["TL.interact"] -> TL.interact id+ ["TL.getContents"] -> TL.putStr =<< TL.getContents+ ["TL.getLine"] -> TL.putStrLn =<< TL.getLine+ _ -> hPutStrLn stderr "invalid directive!" >> exitFailure
+ tests/Tests/Properties.hs view
@@ -0,0 +1,1189 @@+-- | General quicktest properties for the text library+--+{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,+ ScopedTypeVariables, TypeSynonymInstances, CPP #-}+{-# OPTIONS_GHC -fno-enable-rewrite-rules #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+module Tests.Properties+ (+ tests+ ) where++import Test.QuickCheck+import Test.QuickCheck.Monadic+import Text.Show.Functions ()++import Control.Arrow ((***), second)+import Control.Exception (catch)+import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)+import Data.Int (Int8, Int16, Int32, Int64)+import Data.Monoid (Monoid(..))+import Data.String (fromString)+import Data.Text.Encoding.Error+import Data.Text.Foreign+import Data.Text.Fusion.Size+import Data.Text.Lazy.Read as TL+import Data.Text.Read as T+import Data.Text.Search (indices)+import Data.Word (Word, Word8, Word16, Word32, Word64)+import Numeric (showHex)+import Prelude hiding (catch, replicate)+import Test.Framework (Test, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)+import qualified Data.Bits as Bits (shiftL, shiftR)+import qualified Data.ByteString as B+import qualified Data.List as L+import qualified Data.Text as T+import qualified Data.Text.Encoding as E+import qualified Data.Text.Fusion as S+import qualified Data.Text.Fusion.Common as S+import qualified Data.Text.IO as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Builder as TB+import qualified Data.Text.Lazy.Builder.Int as TB+import qualified Data.Text.Lazy.Builder.RealFloat as TB+import qualified Data.Text.Lazy.Encoding as EL+import qualified Data.Text.Lazy.Fusion as SL+import qualified Data.Text.Lazy.IO as TL+import qualified Data.Text.Lazy.Search as S (indices)+import qualified Data.Text.UnsafeShift as U+import qualified System.IO as IO++import Tests.QuickCheckUtils+import Tests.Utils+import qualified Tests.SlowFunctions as Slow++t_pack_unpack = (T.unpack . T.pack) `eq` id+tl_pack_unpack = (TL.unpack . TL.pack) `eq` id+t_stream_unstream = (S.unstream . S.stream) `eq` id+tl_stream_unstream = (SL.unstream . SL.stream) `eq` id+t_reverse_stream t = (S.reverse . S.reverseStream) t == t+t_singleton c = [c] == (T.unpack . T.singleton) c+tl_singleton c = [c] == (TL.unpack . TL.singleton) c+tl_unstreamChunks x = f 11 x == f 1000 x+ where f n = SL.unstreamChunks n . S.streamList+tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id+tl_from_to_strict = (TL.fromStrict . TL.toStrict) `eq` id++t_ascii t = E.decodeASCII (E.encodeUtf8 a) == a+ where a = T.map (\c -> chr (ord c `mod` 128)) t+tl_ascii t = EL.decodeASCII (EL.encodeUtf8 a) == a+ where a = TL.map (\c -> chr (ord c `mod` 128)) t+t_utf8 = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id+t_utf8' = forAll genUnicode $ (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right)+tl_utf8 = forAll genUnicode $ (EL.decodeUtf8 . EL.encodeUtf8) `eq` id+tl_utf8' = forAll genUnicode $ (EL.decodeUtf8' . EL.encodeUtf8) `eq` (id . Right)+t_utf16LE = forAll genUnicode $ (E.decodeUtf16LE . E.encodeUtf16LE) `eq` id+tl_utf16LE = forAll genUnicode $ (EL.decodeUtf16LE . EL.encodeUtf16LE) `eq` id+t_utf16BE = forAll genUnicode $ (E.decodeUtf16BE . E.encodeUtf16BE) `eq` id+tl_utf16BE = forAll genUnicode $ (EL.decodeUtf16BE . EL.encodeUtf16BE) `eq` id+t_utf32LE = forAll genUnicode $ (E.decodeUtf32LE . E.encodeUtf32LE) `eq` id+tl_utf32LE = forAll genUnicode $ (EL.decodeUtf32LE . EL.encodeUtf32LE) `eq` id+t_utf32BE = forAll genUnicode $ (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id+tl_utf32BE = forAll genUnicode $ (EL.decodeUtf32BE . EL.encodeUtf32BE) `eq` id++-- This is a poor attempt to ensure that the error handling paths on+-- decode are exercised in some way. Proper testing would be rather+-- more involved.+t_utf8_err :: DecodeErr -> B.ByteString -> Property+t_utf8_err (DE _ de) bs = monadicIO $ do+ l <- run $ let len = T.length (E.decodeUtf8With de bs)+ in (len `seq` return (Right len)) `catch`+ (\(e::UnicodeException) -> return (Left e))+ case l of+ Left err -> assert $ length (show err) >= 0+ Right n -> assert $ n >= 0++t_utf8_err' :: B.ByteString -> Property+t_utf8_err' bs = monadicIO . assert $ case E.decodeUtf8' bs of+ Left err -> length (show err) >= 0+ Right t -> T.length t >= 0++s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)+ where _types = s :: String+sf_Eq p s =+ ((L.filter p s==) . L.filter p) `eq`+ (((S.filter p $ S.streamList s)==) . S.filter p . S.streamList)+t_Eq s = (s==) `eq` ((T.pack s==) . T.pack)+tl_Eq s = (s==) `eq` ((TL.pack s==) . TL.pack)+s_Ord s = (compare s) `eq` (compare (S.streamList s) . S.streamList)+ where _types = s :: String+sf_Ord p s =+ ((compare $ L.filter p s) . L.filter p) `eq`+ (compare (S.filter p $ S.streamList s) . S.filter p . S.streamList)+t_Ord s = (compare s) `eq` (compare (T.pack s) . T.pack)+tl_Ord s = (compare s) `eq` (compare (TL.pack s) . TL.pack)+t_Read = id `eq` (T.unpack . read . show)+tl_Read = id `eq` (TL.unpack . read . show)+t_Show = show `eq` (show . T.pack)+tl_Show = show `eq` (show . TL.pack)+t_mappend s = mappend s`eqP` (unpackS . mappend (T.pack s))+tl_mappend s = mappend s`eqP` (unpackS . mappend (TL.pack s))+t_mconcat = mconcat `eq` (unpackS . mconcat . L.map T.pack)+tl_mconcat = mconcat `eq` (unpackS . mconcat . L.map TL.pack)+t_mempty = mempty == (unpackS (mempty :: T.Text))+tl_mempty = mempty == (unpackS (mempty :: TL.Text))+t_IsString = fromString `eqP` (T.unpack . fromString)+tl_IsString = fromString `eqP` (TL.unpack . fromString)++s_cons x = (x:) `eqP` (unpackS . S.cons x)+s_cons_s x = (x:) `eqP` (unpackS . S.unstream . S.cons x)+sf_cons p x = ((x:) . L.filter p) `eqP` (unpackS . S.cons x . S.filter p)+t_cons x = (x:) `eqP` (unpackS . T.cons x)+tl_cons x = (x:) `eqP` (unpackS . TL.cons x)+s_snoc x = (++ [x]) `eqP` (unpackS . (flip S.snoc) x)+t_snoc x = (++ [x]) `eqP` (unpackS . (flip T.snoc) x)+tl_snoc x = (++ [x]) `eqP` (unpackS . (flip TL.snoc) x)+s_append s = (s++) `eqP` (unpackS . S.append (S.streamList s))+s_append_s s = (s++) `eqP`+ (unpackS . S.unstream . S.append (S.streamList s))+sf_append p s = (L.filter p s++) `eqP`+ (unpackS . S.append (S.filter p $ S.streamList s))+t_append s = (s++) `eqP` (unpackS . T.append (packS s))++uncons (x:xs) = Just (x,xs)+uncons _ = Nothing++s_uncons = uncons `eqP` (fmap (second unpackS) . S.uncons)+sf_uncons p = (uncons . L.filter p) `eqP`+ (fmap (second unpackS) . S.uncons . S.filter p)+t_uncons = uncons `eqP` (fmap (second unpackS) . T.uncons)+tl_uncons = uncons `eqP` (fmap (second unpackS) . TL.uncons)+s_head = head `eqP` S.head+sf_head p = (head . L.filter p) `eqP` (S.head . S.filter p)+t_head = head `eqP` T.head+tl_head = head `eqP` TL.head+s_last = last `eqP` S.last+sf_last p = (last . L.filter p) `eqP` (S.last . S.filter p)+t_last = last `eqP` T.last+tl_last = last `eqP` TL.last+s_tail = tail `eqP` (unpackS . S.tail)+s_tail_s = tail `eqP` (unpackS . S.unstream . S.tail)+sf_tail p = (tail . L.filter p) `eqP` (unpackS . S.tail . S.filter p)+t_tail = tail `eqP` (unpackS . T.tail)+tl_tail = tail `eqP` (unpackS . TL.tail)+s_init = init `eqP` (unpackS . S.init)+s_init_s = init `eqP` (unpackS . S.unstream . S.init)+sf_init p = (init . L.filter p) `eqP` (unpackS . S.init . S.filter p)+t_init = init `eqP` (unpackS . T.init)+tl_init = init `eqP` (unpackS . TL.init)+s_null = null `eqP` S.null+sf_null p = (null . L.filter p) `eqP` (S.null . S.filter p)+t_null = null `eqP` T.null+tl_null = null `eqP` TL.null+s_length = length `eqP` S.length+sf_length p = (length . L.filter p) `eqP` (S.length . S.filter p)+sl_length = (fromIntegral . length) `eqP` SL.length+t_length = length `eqP` T.length+tl_length = L.genericLength `eqP` TL.length+t_compareLength t = (compare (T.length t)) `eq` T.compareLength t+tl_compareLength t= (compare (TL.length t)) `eq` TL.compareLength t++s_map f = map f `eqP` (unpackS . S.map f)+s_map_s f = map f `eqP` (unpackS . S.unstream . S.map f)+sf_map p f = (map f . L.filter p) `eqP` (unpackS . S.map f . S.filter p)+t_map f = map f `eqP` (unpackS . T.map f)+tl_map f = map f `eqP` (unpackS . TL.map f)+s_intercalate c = L.intercalate c `eq`+ (unpackS . S.intercalate (packS c) . map packS)+t_intercalate c = L.intercalate c `eq`+ (unpackS . T.intercalate (packS c) . map packS)+tl_intercalate c = L.intercalate c `eq`+ (unpackS . TL.intercalate (TL.pack c) . map TL.pack)+s_intersperse c = L.intersperse c `eqP`+ (unpackS . S.intersperse c)+s_intersperse_s c = L.intersperse c `eqP`+ (unpackS . S.unstream . S.intersperse c)+sf_intersperse p c= (L.intersperse c . L.filter p) `eqP`+ (unpackS . S.intersperse c . S.filter p)+t_intersperse c = L.intersperse c `eqP` (unpackS . T.intersperse c)+tl_intersperse c = L.intersperse c `eqP` (unpackS . TL.intersperse c)+t_transpose = L.transpose `eq` (map unpackS . T.transpose . map packS)+tl_transpose = L.transpose `eq` (map unpackS . TL.transpose . map TL.pack)+t_reverse = L.reverse `eqP` (unpackS . T.reverse)+tl_reverse = L.reverse `eqP` (unpackS . TL.reverse)+t_reverse_short n = L.reverse `eqP` (unpackS . S.reverse . shorten n . S.stream)++t_replace s d = (L.intercalate d . splitOn s) `eqP`+ (unpackS . T.replace (T.pack s) (T.pack d))+tl_replace s d = (L.intercalate d . splitOn s) `eqP`+ (unpackS . TL.replace (TL.pack s) (TL.pack d))++splitOn :: (Eq a) => [a] -> [a] -> [[a]]+splitOn pat src0+ | l == 0 = error "empty"+ | otherwise = go src0+ where+ l = length pat+ go src = search 0 src+ where+ search _ [] = [src]+ search !n s@(_:s')+ | pat `L.isPrefixOf` s = take n src : go (drop l s)+ | otherwise = search (n+1) s'++s_toCaseFold_length xs = S.length (S.toCaseFold s) >= length xs+ where s = S.streamList xs+sf_toCaseFold_length p xs =+ (S.length . S.toCaseFold . S.filter p $ s) >= (length . L.filter p $ xs)+ where s = S.streamList xs+t_toCaseFold_length t = T.length (T.toCaseFold t) >= T.length t+tl_toCaseFold_length t = TL.length (TL.toCaseFold t) >= TL.length t+t_toLower_length t = T.length (T.toLower t) >= T.length t+t_toLower_lower t = p (T.toLower t) >= p t+ where p = T.length . T.filter isLower+tl_toLower_lower t = p (TL.toLower t) >= p t+ where p = TL.length . TL.filter isLower+t_toUpper_length t = T.length (T.toUpper t) >= T.length t+t_toUpper_upper t = p (T.toUpper t) >= p t+ where p = T.length . T.filter isUpper+tl_toUpper_upper t = p (TL.toUpper t) >= p t+ where p = TL.length . TL.filter isUpper++justifyLeft k c xs = xs ++ L.replicate (k - length xs) c+justifyRight m n xs = L.replicate (m - length xs) n ++ xs+center k c xs+ | len >= k = xs+ | otherwise = L.replicate l c ++ xs ++ L.replicate r c+ where len = length xs+ d = k - len+ r = d `div` 2+ l = d - r++s_justifyLeft k c = justifyLeft j c `eqP` (unpackS . S.justifyLeftI j c)+ where j = fromIntegral (k :: Word8)+s_justifyLeft_s k c = justifyLeft j c `eqP`+ (unpackS . S.unstream . S.justifyLeftI j c)+ where j = fromIntegral (k :: Word8)+sf_justifyLeft p k c = (justifyLeft j c . L.filter p) `eqP`+ (unpackS . S.justifyLeftI j c . S.filter p)+ where j = fromIntegral (k :: Word8)+t_justifyLeft k c = justifyLeft j c `eqP` (unpackS . T.justifyLeft j c)+ where j = fromIntegral (k :: Word8)+tl_justifyLeft k c = justifyLeft j c `eqP`+ (unpackS . TL.justifyLeft (fromIntegral j) c)+ where j = fromIntegral (k :: Word8)+t_justifyRight k c = justifyRight j c `eqP` (unpackS . T.justifyRight j c)+ where j = fromIntegral (k :: Word8)+tl_justifyRight k c = justifyRight j c `eqP`+ (unpackS . TL.justifyRight (fromIntegral j) c)+ where j = fromIntegral (k :: Word8)+t_center k c = center j c `eqP` (unpackS . T.center j c)+ where j = fromIntegral (k :: Word8)+tl_center k c = center j c `eqP` (unpackS . TL.center (fromIntegral j) c)+ where j = fromIntegral (k :: Word8)++sf_foldl p f z = (L.foldl f z . L.filter p) `eqP` (S.foldl f z . S.filter p)+ where _types = f :: Char -> Char -> Char+t_foldl f z = L.foldl f z `eqP` (T.foldl f z)+ where _types = f :: Char -> Char -> Char+tl_foldl f z = L.foldl f z `eqP` (TL.foldl f z)+ where _types = f :: Char -> Char -> Char+sf_foldl' p f z = (L.foldl' f z . L.filter p) `eqP`+ (S.foldl' f z . S.filter p)+ where _types = f :: Char -> Char -> Char+t_foldl' f z = L.foldl' f z `eqP` T.foldl' f z+ where _types = f :: Char -> Char -> Char+tl_foldl' f z = L.foldl' f z `eqP` TL.foldl' f z+ where _types = f :: Char -> Char -> Char+sf_foldl1 p f = (L.foldl1 f . L.filter p) `eqP` (S.foldl1 f . S.filter p)+t_foldl1 f = L.foldl1 f `eqP` T.foldl1 f+tl_foldl1 f = L.foldl1 f `eqP` TL.foldl1 f+sf_foldl1' p f = (L.foldl1' f . L.filter p) `eqP` (S.foldl1' f . S.filter p)+t_foldl1' f = L.foldl1' f `eqP` T.foldl1' f+tl_foldl1' f = L.foldl1' f `eqP` TL.foldl1' f+sf_foldr p f z = (L.foldr f z . L.filter p) `eqP` (S.foldr f z . S.filter p)+ where _types = f :: Char -> Char -> Char+t_foldr f z = L.foldr f z `eqP` T.foldr f z+ where _types = f :: Char -> Char -> Char+tl_foldr f z = L.foldr f z `eqP` TL.foldr f z+ where _types = f :: Char -> Char -> Char+sf_foldr1 p f = (L.foldr1 f . L.filter p) `eqP` (S.foldr1 f . S.filter p)+t_foldr1 f = L.foldr1 f `eqP` T.foldr1 f+tl_foldr1 f = L.foldr1 f `eqP` TL.foldr1 f++s_concat_s = L.concat `eq` (unpackS . S.unstream . S.concat . map packS)+sf_concat p = (L.concat . map (L.filter p)) `eq`+ (unpackS . S.concat . map (S.filter p . packS))+t_concat = L.concat `eq` (unpackS . T.concat . map packS)+tl_concat = L.concat `eq` (unpackS . TL.concat . map TL.pack)+sf_concatMap p f = unsquare $ (L.concatMap f . L.filter p) `eqP`+ (unpackS . S.concatMap (packS . f) . S.filter p)+t_concatMap f = unsquare $+ L.concatMap f `eqP` (unpackS . T.concatMap (packS . f))+tl_concatMap f = unsquare $+ L.concatMap f `eqP` (unpackS . TL.concatMap (TL.pack . f))+sf_any q p = (L.any p . L.filter q) `eqP` (S.any p . S.filter q)+t_any p = L.any p `eqP` T.any p+tl_any p = L.any p `eqP` TL.any p+sf_all q p = (L.all p . L.filter q) `eqP` (S.all p . S.filter q)+t_all p = L.all p `eqP` T.all p+tl_all p = L.all p `eqP` TL.all p+sf_maximum p = (L.maximum . L.filter p) `eqP` (S.maximum . S.filter p)+t_maximum = L.maximum `eqP` T.maximum+tl_maximum = L.maximum `eqP` TL.maximum+sf_minimum p = (L.minimum . L.filter p) `eqP` (S.minimum . S.filter p)+t_minimum = L.minimum `eqP` T.minimum+tl_minimum = L.minimum `eqP` TL.minimum++sf_scanl p f z = (L.scanl f z . L.filter p) `eqP`+ (unpackS . S.scanl f z . S.filter p)+t_scanl f z = L.scanl f z `eqP` (unpackS . T.scanl f z)+tl_scanl f z = L.scanl f z `eqP` (unpackS . TL.scanl f z)+t_scanl1 f = L.scanl1 f `eqP` (unpackS . T.scanl1 f)+tl_scanl1 f = L.scanl1 f `eqP` (unpackS . TL.scanl1 f)+t_scanr f z = L.scanr f z `eqP` (unpackS . T.scanr f z)+tl_scanr f z = L.scanr f z `eqP` (unpackS . TL.scanr f z)+t_scanr1 f = L.scanr1 f `eqP` (unpackS . T.scanr1 f)+tl_scanr1 f = L.scanr1 f `eqP` (unpackS . TL.scanr1 f)++t_mapAccumL f z = L.mapAccumL f z `eqP` (second unpackS . T.mapAccumL f z)+ where _types = f :: Int -> Char -> (Int,Char)+tl_mapAccumL f z = L.mapAccumL f z `eqP` (second unpackS . TL.mapAccumL f z)+ where _types = f :: Int -> Char -> (Int,Char)+t_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . T.mapAccumR f z)+ where _types = f :: Int -> Char -> (Int,Char)+tl_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . TL.mapAccumR f z)+ where _types = f :: Int -> Char -> (Int,Char)++replicate n l = concat (L.replicate n l)++s_replicate n = replicate m `eq`+ (unpackS . S.replicateI (fromIntegral m) . packS)+ where m = fromIntegral (n :: Word8)+t_replicate n = replicate m `eq` (unpackS . T.replicate m . packS)+ where m = fromIntegral (n :: Word8)+tl_replicate n = replicate m `eq`+ (unpackS . TL.replicate (fromIntegral m) . packS)+ where m = fromIntegral (n :: Word8)++unf :: Int -> Char -> Maybe (Char, Char)+unf n c | fromEnum c * 100 > n = Nothing+ | otherwise = Just (c, succ c)++t_unfoldr n = L.unfoldr (unf m) `eq` (unpackS . T.unfoldr (unf m))+ where m = fromIntegral (n :: Word16)+tl_unfoldr n = L.unfoldr (unf m) `eq` (unpackS . TL.unfoldr (unf m))+ where m = fromIntegral (n :: Word16)+t_unfoldrN n m = (L.take i . L.unfoldr (unf j)) `eq`+ (unpackS . T.unfoldrN i (unf j))+ where i = fromIntegral (n :: Word16)+ j = fromIntegral (m :: Word16)+tl_unfoldrN n m = (L.take i . L.unfoldr (unf j)) `eq`+ (unpackS . TL.unfoldrN (fromIntegral i) (unf j))+ where i = fromIntegral (n :: Word16)+ j = fromIntegral (m :: Word16)++unpack2 :: (Stringy s) => (s,s) -> (String,String)+unpack2 = unpackS *** unpackS++s_take n = L.take n `eqP` (unpackS . S.take n)+s_take_s m = L.take n `eqP` (unpackS . S.unstream . S.take n)+ where n = small m+sf_take p n = (L.take n . L.filter p) `eqP`+ (unpackS . S.take n . S.filter p)+t_take n = L.take n `eqP` (unpackS . T.take n)+tl_take n = L.take n `eqP` (unpackS . TL.take (fromIntegral n))+s_drop n = L.drop n `eqP` (unpackS . S.drop n)+s_drop_s m = L.drop n `eqP` (unpackS . S.unstream . S.drop n)+ where n = small m+sf_drop p n = (L.drop n . L.filter p) `eqP`+ (unpackS . S.drop n . S.filter p)+t_drop n = L.drop n `eqP` (unpackS . T.drop n)+tl_drop n = L.drop n `eqP` (unpackS . TL.drop (fromIntegral n))+s_take_drop m = (L.take n . L.drop n) `eqP` (unpackS . S.take n . S.drop n)+ where n = small m+s_take_drop_s m = (L.take n . L.drop n) `eqP`+ (unpackS . S.unstream . S.take n . S.drop n)+ where n = small m+s_takeWhile p = L.takeWhile p `eqP` (unpackS . S.takeWhile p)+s_takeWhile_s p = L.takeWhile p `eqP` (unpackS . S.unstream . S.takeWhile p)+sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP`+ (unpackS . S.takeWhile p . S.filter q)+t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)+tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)+s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)+s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)+sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`+ (unpackS . S.dropWhile p . S.filter q)+t_dropWhile p = L.dropWhile p `eqP` (unpackS . T.dropWhile p)+tl_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)+t_dropWhileEnd p = (L.reverse . L.dropWhile p . L.reverse) `eqP`+ (unpackS . T.dropWhileEnd p)+tl_dropWhileEnd p = (L.reverse . L.dropWhile p . L.reverse) `eqP`+ (unpackS . TL.dropWhileEnd p)+t_dropAround p = (L.dropWhile p . L.reverse . L.dropWhile p . L.reverse)+ `eqP` (unpackS . T.dropAround p)+tl_dropAround p = (L.dropWhile p . L.reverse . L.dropWhile p . L.reverse)+ `eqP` (unpackS . TL.dropAround p)+t_stripStart = T.dropWhile isSpace `eq` T.stripStart+tl_stripStart = TL.dropWhile isSpace `eq` TL.stripStart+t_stripEnd = T.dropWhileEnd isSpace `eq` T.stripEnd+tl_stripEnd = TL.dropWhileEnd isSpace `eq` TL.stripEnd+t_strip = T.dropAround isSpace `eq` T.strip+tl_strip = TL.dropAround isSpace `eq` TL.strip+t_splitAt n = L.splitAt n `eqP` (unpack2 . T.splitAt n)+tl_splitAt n = L.splitAt n `eqP` (unpack2 . TL.splitAt (fromIntegral n))+t_span p = L.span p `eqP` (unpack2 . T.span p)+tl_span p = L.span p `eqP` (unpack2 . TL.span p)++t_breakOn_id s = squid `eq` (uncurry T.append . T.breakOn s)+ where squid t | T.null s = error "empty"+ | otherwise = t+tl_breakOn_id s = squid `eq` (uncurry TL.append . TL.breakOn s)+ where squid t | TL.null s = error "empty"+ | otherwise = t+t_breakOn_start (NotEmpty s) t =+ let (k,m) = T.breakOn s t+ in k `T.isPrefixOf` t && (T.null m || s `T.isPrefixOf` m)+tl_breakOn_start (NotEmpty s) t =+ let (k,m) = TL.breakOn s t+ in k `TL.isPrefixOf` t && TL.null m || s `TL.isPrefixOf` m+t_breakOnEnd_end (NotEmpty s) t =+ let (m,k) = T.breakOnEnd s t+ in k `T.isSuffixOf` t && (T.null m || s `T.isSuffixOf` m)+tl_breakOnEnd_end (NotEmpty s) t =+ let (m,k) = TL.breakOnEnd s t+ in k `TL.isSuffixOf` t && (TL.null m || s `TL.isSuffixOf` m)+t_break p = L.break p `eqP` (unpack2 . T.break p)+tl_break p = L.break p `eqP` (unpack2 . TL.break p)+t_group = L.group `eqP` (map unpackS . T.group)+tl_group = L.group `eqP` (map unpackS . TL.group)+t_groupBy p = L.groupBy p `eqP` (map unpackS . T.groupBy p)+tl_groupBy p = L.groupBy p `eqP` (map unpackS . TL.groupBy p)+t_inits = L.inits `eqP` (map unpackS . T.inits)+tl_inits = L.inits `eqP` (map unpackS . TL.inits)+t_tails = L.tails `eqP` (map unpackS . T.tails)+tl_tails = L.tails `eqP` (map unpackS . TL.tails)+t_findAppendId (NotEmpty s) = unsquare $ \ts ->+ let t = T.intercalate s ts+ in all (==t) $ map (uncurry T.append) (T.breakOnAll s t)+tl_findAppendId (NotEmpty s) = unsquare $ \ts ->+ let t = TL.intercalate s ts+ in all (==t) $ map (uncurry TL.append) (TL.breakOnAll s t)+t_findContains (NotEmpty s) = all (T.isPrefixOf s . snd) . T.breakOnAll s .+ T.intercalate s+tl_findContains (NotEmpty s) = all (TL.isPrefixOf s . snd) .+ TL.breakOnAll s . TL.intercalate s+sl_filterCount c = (L.genericLength . L.filter (==c)) `eqP` SL.countChar c+t_findCount s = (L.length . T.breakOnAll s) `eq` T.count s+tl_findCount s = (L.genericLength . TL.breakOnAll s) `eq` TL.count s++t_splitOn_split s = (T.splitOn s `eq` Slow.splitOn s) . T.intercalate s+tl_splitOn_split s = ((TL.splitOn (TL.fromStrict s) . TL.fromStrict) `eq`+ (map TL.fromStrict . T.splitOn s)) . T.intercalate s+t_splitOn_i (NotEmpty t) = id `eq` (T.intercalate t . T.splitOn t)+tl_splitOn_i (NotEmpty t) = id `eq` (TL.intercalate t . TL.splitOn t)++t_split p = split p `eqP` (map unpackS . T.split p)+t_split_count c = (L.length . T.split (==c)) `eq`+ ((1+) . T.count (T.singleton c))+t_split_splitOn c = T.split (==c) `eq` T.splitOn (T.singleton c)+tl_split p = split p `eqP` (map unpackS . TL.split p)++split :: (a -> Bool) -> [a] -> [[a]]+split _ [] = [[]]+split p xs = loop xs+ where loop s | null s' = [l]+ | otherwise = l : loop (tail s')+ where (l, s') = break p s++t_chunksOf_same_lengths k = all ((==k) . T.length) . ini . T.chunksOf k+ where ini [] = []+ ini xs = init xs++t_chunksOf_length k t = len == T.length t || (k <= 0 && len == 0)+ where len = L.sum . L.map T.length $ T.chunksOf k t++tl_chunksOf k = T.chunksOf k `eq` (map (T.concat . TL.toChunks) .+ TL.chunksOf (fromIntegral k) . TL.fromStrict)++t_lines = L.lines `eqP` (map unpackS . T.lines)+tl_lines = L.lines `eqP` (map unpackS . TL.lines)+{-+t_lines' = lines' `eqP` (map unpackS . 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'+-}+t_words = L.words `eqP` (map unpackS . T.words)++tl_words = L.words `eqP` (map unpackS . TL.words)+t_unlines = L.unlines `eq` (unpackS . T.unlines . map packS)+tl_unlines = L.unlines `eq` (unpackS . TL.unlines . map packS)+t_unwords = L.unwords `eq` (unpackS . T.unwords . map packS)+tl_unwords = L.unwords `eq` (unpackS . TL.unwords . map packS)++s_isPrefixOf s = L.isPrefixOf s `eqP`+ (S.isPrefixOf (S.stream $ packS s) . S.stream)+sf_isPrefixOf p s = (L.isPrefixOf s . L.filter p) `eqP`+ (S.isPrefixOf (S.stream $ packS s) . S.filter p . S.stream)+t_isPrefixOf s = L.isPrefixOf s`eqP` T.isPrefixOf (packS s)+tl_isPrefixOf s = L.isPrefixOf s`eqP` TL.isPrefixOf (packS s)+t_isSuffixOf s = L.isSuffixOf s`eqP` T.isSuffixOf (packS s)+tl_isSuffixOf s = L.isSuffixOf s`eqP` TL.isSuffixOf (packS s)+t_isInfixOf s = L.isInfixOf s `eqP` T.isInfixOf (packS s)+tl_isInfixOf s = L.isInfixOf s `eqP` TL.isInfixOf (packS s)++t_stripPrefix s = (fmap packS . L.stripPrefix s) `eqP` T.stripPrefix (packS s)+tl_stripPrefix s = (fmap packS . L.stripPrefix s) `eqP` TL.stripPrefix (packS s)++stripSuffix p t = reverse `fmap` L.stripPrefix (reverse p) (reverse t)++t_stripSuffix s = (fmap packS . stripSuffix s) `eqP` T.stripSuffix (packS s)+tl_stripSuffix s = (fmap packS . stripSuffix s) `eqP` TL.stripSuffix (packS s)++commonPrefixes a0@(_:_) b0@(_:_) = Just (go a0 b0 [])+ where go (a:as) (b:bs) ps+ | a == b = go as bs (a:ps)+ go as bs ps = (reverse ps,as,bs)+commonPrefixes _ _ = Nothing++t_commonPrefixes a b (NonEmpty p)+ = commonPrefixes pa pb ==+ repack `fmap` T.commonPrefixes (packS pa) (packS pb)+ where repack (x,y,z) = (unpackS x,unpackS y,unpackS z)+ pa = p ++ a+ pb = p ++ b++tl_commonPrefixes a b (NonEmpty p)+ = commonPrefixes pa pb ==+ repack `fmap` TL.commonPrefixes (packS pa) (packS pb)+ where repack (x,y,z) = (unpackS x,unpackS y,unpackS z)+ pa = p ++ a+ pb = p ++ b++sf_elem p c = (L.elem c . L.filter p) `eqP` (S.elem c . S.filter p)+sf_filter q p = (L.filter p . L.filter q) `eqP`+ (unpackS . S.filter p . S.filter q)+t_filter p = L.filter p `eqP` (unpackS . T.filter p)+tl_filter p = L.filter p `eqP` (unpackS . TL.filter p)+sf_findBy q p = (L.find p . L.filter q) `eqP` (S.findBy p . S.filter q)+t_find p = L.find p `eqP` T.find p+tl_find p = L.find p `eqP` TL.find p+t_partition p = L.partition p `eqP` (unpack2 . T.partition p)+tl_partition p = L.partition p `eqP` (unpack2 . TL.partition p)++sf_index p s = forAll (choose (-l,l*2))+ ((L.filter p s L.!!) `eq` S.index (S.filter p $ packS s))+ where l = L.length s+t_index s = forAll (choose (-l,l*2)) ((s L.!!) `eq` T.index (packS s))+ where l = L.length s++tl_index s = forAll (choose (-l,l*2))+ ((s L.!!) `eq` (TL.index (packS s) . fromIntegral))+ where l = L.length s++t_findIndex p = L.findIndex p `eqP` T.findIndex p+t_count (NotEmpty t) = (subtract 1 . L.length . T.splitOn t) `eq` T.count t+tl_count (NotEmpty t) = (subtract 1 . L.genericLength . TL.splitOn t) `eq`+ TL.count t+t_zip s = L.zip s `eqP` T.zip (packS s)+tl_zip s = L.zip s `eqP` TL.zip (packS s)+sf_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)+t_zipWith c s = L.zipWith c s `eqP` (unpackS . T.zipWith c (packS s))+tl_zipWith c s = L.zipWith c s `eqP` (unpackS . TL.zipWith c (packS s))++t_indices (NotEmpty s) = Slow.indices s `eq` indices s+tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s+ where lazyIndices ss t = map fromIntegral $ Slow.indices (conc ss) (conc t)+ conc = T.concat . TL.toChunks+t_indices_occurs (NotEmpty t) ts = let s = T.intercalate t ts+ in Slow.indices t s == indices t s++-- Bit shifts.+shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k+ where width = round (log (fromIntegral m) / log 2 :: Double)+ (m,_) = (maxBound, m == w)+shiftR w = forAll (choose (0,width-1)) $ \k -> Bits.shiftR w k == U.shiftR w k+ where width = round (log (fromIntegral m) / log 2 :: Double)+ (m,_) = (maxBound, m == w)++shiftL_Int = shiftL :: Int -> Property+shiftL_Word16 = shiftL :: Word16 -> Property+shiftL_Word32 = shiftL :: Word32 -> Property+shiftR_Int = shiftR :: Int -> Property+shiftR_Word16 = shiftR :: Word16 -> Property+shiftR_Word32 = shiftR :: Word32 -> Property++-- Builder.++tb_singleton = id `eqP`+ (unpackS . TB.toLazyText . mconcat . map TB.singleton)+tb_fromText = L.concat `eq` (unpackS . TB.toLazyText . mconcat .+ map (TB.fromText . packS))+tb_associative s1 s2 s3 =+ TB.toLazyText (b1 `mappend` (b2 `mappend` b3)) ==+ TB.toLazyText ((b1 `mappend` b2) `mappend` b3)+ where b1 = TB.fromText (packS s1)+ b2 = TB.fromText (packS s2)+ b3 = TB.fromText (packS s3)++-- Numeric builder stuff.++tb_decimal :: (Integral a, Show a) => a -> Bool+tb_decimal = (TB.toLazyText . TB.decimal) `eq` (TL.pack . show)++tb_decimal_integer (a::Integer) = tb_decimal a+tb_decimal_int (a::Int) = tb_decimal a+tb_decimal_int8 (a::Int8) = tb_decimal a+tb_decimal_int16 (a::Int16) = tb_decimal a+tb_decimal_int32 (a::Int32) = tb_decimal a+tb_decimal_int64 (a::Int64) = tb_decimal a+tb_decimal_word (a::Word) = tb_decimal a+tb_decimal_word8 (a::Word8) = tb_decimal a+tb_decimal_word16 (a::Word16) = tb_decimal a+tb_decimal_word32 (a::Word32) = tb_decimal a+tb_decimal_word64 (a::Word64) = tb_decimal a++tb_hex :: (Integral a, Show a) => a -> Bool+tb_hex = (TB.toLazyText . TB.hexadecimal) `eq` (TL.pack . flip showHex "")++tb_hexadecimal_integer (a::Integer) = tb_hex a+tb_hexadecimal_int (a::Int) = tb_hex a+tb_hexadecimal_int8 (a::Int8) = tb_hex a+tb_hexadecimal_int16 (a::Int16) = tb_hex a+tb_hexadecimal_int32 (a::Int32) = tb_hex a+tb_hexadecimal_int64 (a::Int64) = tb_hex a+tb_hexadecimal_word (a::Word) = tb_hex a+tb_hexadecimal_word8 (a::Word8) = tb_hex a+tb_hexadecimal_word16 (a::Word16) = tb_hex a+tb_hexadecimal_word32 (a::Word32) = tb_hex a+tb_hexadecimal_word64 (a::Word64) = tb_hex a++tb_realfloat :: (RealFloat a, Show a) => a -> Bool+tb_realfloat = (TB.toLazyText . TB.realFloat) `eq` (TL.pack . show)++tb_realfloat_float (a::Float) = tb_realfloat a+tb_realfloat_double (a::Double) = tb_realfloat a++-- Reading.++t_decimal (n::Int) s =+ T.signed T.decimal (T.pack (show n) `T.append` t) == Right (n,t)+ where t = T.dropWhile isDigit s+tl_decimal (n::Int) s =+ TL.signed TL.decimal (TL.pack (show n) `TL.append` t) == Right (n,t)+ where t = TL.dropWhile isDigit s+t_hexadecimal (n::Positive Int) s ox =+ T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) == Right (n,t)+ where t = T.dropWhile isHexDigit s+ p = if ox then "0x" else ""+tl_hexadecimal (n::Positive Int) s ox =+ TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) == Right (n,t)+ where t = TL.dropWhile isHexDigit s+ p = if ox then "0x" else ""++isFloaty c = c `elem` "+-.0123456789eE"++t_read_rational p tol (n::Double) s =+ case p (T.pack (show n) `T.append` t) of+ Left _err -> False+ Right (n',t') -> t == t' && abs (n-n') <= tol+ where t = T.dropWhile isFloaty s++tl_read_rational p tol (n::Double) s =+ case p (TL.pack (show n) `TL.append` t) of+ Left _err -> False+ Right (n',t') -> t == t' && abs (n-n') <= tol+ where t = TL.dropWhile isFloaty s++t_double = t_read_rational T.double 1e-13+tl_double = tl_read_rational TL.double 1e-13+t_rational = t_read_rational T.rational 1e-16+tl_rational = tl_read_rational TL.rational 1e-16++-- Input and output.++t_put_get = write_read T.unlines T.filter put get+ where put h = withRedirect h IO.stdout . T.putStr+ get h = withRedirect h IO.stdin T.getContents+tl_put_get = write_read TL.unlines TL.filter put get+ where put h = withRedirect h IO.stdout . TL.putStr+ get h = withRedirect h IO.stdin TL.getContents+t_write_read = write_read T.unlines T.filter T.hPutStr T.hGetContents+tl_write_read = write_read TL.unlines TL.filter TL.hPutStr TL.hGetContents++t_write_read_line e m b t = write_read head T.filter T.hPutStrLn+ T.hGetLine e m b [t]+tl_write_read_line e m b t = write_read head TL.filter TL.hPutStrLn+ TL.hGetLine e m b [t]++-- Low-level.++t_dropWord16 m t = dropWord16 m t `T.isSuffixOf` t+t_takeWord16 m t = takeWord16 m t `T.isPrefixOf` t+t_take_drop_16 m t = T.append (takeWord16 n t) (dropWord16 n t) == t+ where n = small m+t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)++-- Regression tests.+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 > 0 = S.Stream arr off (smaller (exactSize n) len)+ | otherwise = t++tests :: Test+tests =+ testGroup "Properties" [+ testGroup "creation/elimination" [+ testProperty "t_pack_unpack" t_pack_unpack,+ testProperty "tl_pack_unpack" tl_pack_unpack,+ testProperty "t_stream_unstream" t_stream_unstream,+ testProperty "tl_stream_unstream" tl_stream_unstream,+ testProperty "t_reverse_stream" t_reverse_stream,+ testProperty "t_singleton" t_singleton,+ testProperty "tl_singleton" tl_singleton,+ testProperty "tl_unstreamChunks" tl_unstreamChunks,+ testProperty "tl_chunk_unchunk" tl_chunk_unchunk,+ testProperty "tl_from_to_strict" tl_from_to_strict+ ],++ testGroup "transcoding" [+ testProperty "t_ascii" t_ascii,+ testProperty "tl_ascii" tl_ascii,+ testProperty "t_utf8" t_utf8,+ testProperty "t_utf8'" t_utf8',+ testProperty "tl_utf8" tl_utf8,+ testProperty "tl_utf8'" tl_utf8',+ testProperty "t_utf16LE" t_utf16LE,+ testProperty "tl_utf16LE" tl_utf16LE,+ testProperty "t_utf16BE" t_utf16BE,+ testProperty "tl_utf16BE" tl_utf16BE,+ testProperty "t_utf32LE" t_utf32LE,+ testProperty "tl_utf32LE" tl_utf32LE,+ testProperty "t_utf32BE" t_utf32BE,+ testProperty "tl_utf32BE" tl_utf32BE,+ testGroup "errors" [+ testProperty "t_utf8_err" t_utf8_err,+ testProperty "t_utf8_err'" t_utf8_err'+ ]+ ],++ testGroup "instances" [+ testProperty "s_Eq" s_Eq,+ testProperty "sf_Eq" sf_Eq,+ testProperty "t_Eq" t_Eq,+ testProperty "tl_Eq" tl_Eq,+ testProperty "s_Ord" s_Ord,+ testProperty "sf_Ord" sf_Ord,+ testProperty "t_Ord" t_Ord,+ testProperty "tl_Ord" tl_Ord,+ testProperty "t_Read" t_Read,+ testProperty "tl_Read" tl_Read,+ testProperty "t_Show" t_Show,+ testProperty "tl_Show" tl_Show,+ testProperty "t_mappend" t_mappend,+ testProperty "tl_mappend" tl_mappend,+ testProperty "t_mconcat" t_mconcat,+ testProperty "tl_mconcat" tl_mconcat,+ testProperty "t_mempty" t_mempty,+ testProperty "tl_mempty" tl_mempty,+ testProperty "t_IsString" t_IsString,+ testProperty "tl_IsString" tl_IsString+ ],++ testGroup "basics" [+ testProperty "s_cons" s_cons,+ testProperty "s_cons_s" s_cons_s,+ testProperty "sf_cons" sf_cons,+ testProperty "t_cons" t_cons,+ testProperty "tl_cons" tl_cons,+ testProperty "s_snoc" s_snoc,+ testProperty "t_snoc" t_snoc,+ testProperty "tl_snoc" tl_snoc,+ testProperty "s_append" s_append,+ testProperty "s_append_s" s_append_s,+ testProperty "sf_append" sf_append,+ testProperty "t_append" t_append,+ testProperty "s_uncons" s_uncons,+ testProperty "sf_uncons" sf_uncons,+ testProperty "t_uncons" t_uncons,+ testProperty "tl_uncons" tl_uncons,+ testProperty "s_head" s_head,+ testProperty "sf_head" sf_head,+ testProperty "t_head" t_head,+ testProperty "tl_head" tl_head,+ testProperty "s_last" s_last,+ testProperty "sf_last" sf_last,+ testProperty "t_last" t_last,+ testProperty "tl_last" tl_last,+ testProperty "s_tail" s_tail,+ testProperty "s_tail_s" s_tail_s,+ testProperty "sf_tail" sf_tail,+ testProperty "t_tail" t_tail,+ testProperty "tl_tail" tl_tail,+ testProperty "s_init" s_init,+ testProperty "s_init_s" s_init_s,+ testProperty "sf_init" sf_init,+ testProperty "t_init" t_init,+ testProperty "tl_init" tl_init,+ testProperty "s_null" s_null,+ testProperty "sf_null" sf_null,+ testProperty "t_null" t_null,+ testProperty "tl_null" tl_null,+ testProperty "s_length" s_length,+ testProperty "sf_length" sf_length,+ testProperty "sl_length" sl_length,+ testProperty "t_length" t_length,+ testProperty "tl_length" tl_length,+ testProperty "t_compareLength" t_compareLength,+ testProperty "tl_compareLength" tl_compareLength+ ],++ testGroup "transformations" [+ testProperty "s_map" s_map,+ testProperty "s_map_s" s_map_s,+ testProperty "sf_map" sf_map,+ testProperty "t_map" t_map,+ testProperty "tl_map" tl_map,+ testProperty "s_intercalate" s_intercalate,+ testProperty "t_intercalate" t_intercalate,+ testProperty "tl_intercalate" tl_intercalate,+ testProperty "s_intersperse" s_intersperse,+ testProperty "s_intersperse_s" s_intersperse_s,+ testProperty "sf_intersperse" sf_intersperse,+ testProperty "t_intersperse" t_intersperse,+ testProperty "tl_intersperse" tl_intersperse,+ testProperty "t_transpose" t_transpose,+ testProperty "tl_transpose" tl_transpose,+ testProperty "t_reverse" t_reverse,+ testProperty "tl_reverse" tl_reverse,+ testProperty "t_reverse_short" t_reverse_short,+ testProperty "t_replace" t_replace,+ testProperty "tl_replace" tl_replace,++ testGroup "case conversion" [+ testProperty "s_toCaseFold_length" s_toCaseFold_length,+ testProperty "sf_toCaseFold_length" sf_toCaseFold_length,+ testProperty "t_toCaseFold_length" t_toCaseFold_length,+ testProperty "tl_toCaseFold_length" tl_toCaseFold_length,+ testProperty "t_toLower_length" t_toLower_length,+ testProperty "t_toLower_lower" t_toLower_lower,+ testProperty "tl_toLower_lower" tl_toLower_lower,+ testProperty "t_toUpper_length" t_toUpper_length,+ testProperty "t_toUpper_upper" t_toUpper_upper,+ testProperty "tl_toUpper_upper" tl_toUpper_upper+ ],++ testGroup "justification" [+ testProperty "s_justifyLeft" s_justifyLeft,+ testProperty "s_justifyLeft_s" s_justifyLeft_s,+ testProperty "sf_justifyLeft" sf_justifyLeft,+ testProperty "t_justifyLeft" t_justifyLeft,+ testProperty "tl_justifyLeft" tl_justifyLeft,+ testProperty "t_justifyRight" t_justifyRight,+ testProperty "tl_justifyRight" tl_justifyRight,+ testProperty "t_center" t_center,+ testProperty "tl_center" tl_center+ ]+ ],++ testGroup "folds" [+ testProperty "sf_foldl" sf_foldl,+ testProperty "t_foldl" t_foldl,+ testProperty "tl_foldl" tl_foldl,+ testProperty "sf_foldl'" sf_foldl',+ testProperty "t_foldl'" t_foldl',+ testProperty "tl_foldl'" tl_foldl',+ testProperty "sf_foldl1" sf_foldl1,+ testProperty "t_foldl1" t_foldl1,+ testProperty "tl_foldl1" tl_foldl1,+ testProperty "t_foldl1'" t_foldl1',+ testProperty "sf_foldl1'" sf_foldl1',+ testProperty "tl_foldl1'" tl_foldl1',+ testProperty "sf_foldr" sf_foldr,+ testProperty "t_foldr" t_foldr,+ testProperty "tl_foldr" tl_foldr,+ testProperty "sf_foldr1" sf_foldr1,+ testProperty "t_foldr1" t_foldr1,+ testProperty "tl_foldr1" tl_foldr1,++ testGroup "special" [+ testProperty "s_concat_s" s_concat_s,+ testProperty "sf_concat" sf_concat,+ testProperty "t_concat" t_concat,+ testProperty "tl_concat" tl_concat,+ testProperty "sf_concatMap" sf_concatMap,+ testProperty "t_concatMap" t_concatMap,+ testProperty "tl_concatMap" tl_concatMap,+ testProperty "sf_any" sf_any,+ testProperty "t_any" t_any,+ testProperty "tl_any" tl_any,+ testProperty "sf_all" sf_all,+ testProperty "t_all" t_all,+ testProperty "tl_all" tl_all,+ testProperty "sf_maximum" sf_maximum,+ testProperty "t_maximum" t_maximum,+ testProperty "tl_maximum" tl_maximum,+ testProperty "sf_minimum" sf_minimum,+ testProperty "t_minimum" t_minimum,+ testProperty "tl_minimum" tl_minimum+ ]+ ],++ testGroup "construction" [+ testGroup "scans" [+ testProperty "sf_scanl" sf_scanl,+ testProperty "t_scanl" t_scanl,+ testProperty "tl_scanl" tl_scanl,+ testProperty "t_scanl1" t_scanl1,+ testProperty "tl_scanl1" tl_scanl1,+ testProperty "t_scanr" t_scanr,+ testProperty "tl_scanr" tl_scanr,+ testProperty "t_scanr1" t_scanr1,+ testProperty "tl_scanr1" tl_scanr1+ ],++ testGroup "mapAccum" [+ testProperty "t_mapAccumL" t_mapAccumL,+ testProperty "tl_mapAccumL" tl_mapAccumL,+ testProperty "t_mapAccumR" t_mapAccumR,+ testProperty "tl_mapAccumR" tl_mapAccumR+ ],++ testGroup "unfolds" [+ testProperty "s_replicate" s_replicate,+ testProperty "t_replicate" t_replicate,+ testProperty "tl_replicate" tl_replicate,+ testProperty "t_unfoldr" t_unfoldr,+ testProperty "tl_unfoldr" tl_unfoldr,+ testProperty "t_unfoldrN" t_unfoldrN,+ testProperty "tl_unfoldrN" tl_unfoldrN+ ]+ ],++ testGroup "substrings" [+ testGroup "breaking" [+ testProperty "s_take" s_take,+ testProperty "s_take_s" s_take_s,+ testProperty "sf_take" sf_take,+ testProperty "t_take" t_take,+ testProperty "tl_take" tl_take,+ testProperty "s_drop" s_drop,+ testProperty "s_drop_s" s_drop_s,+ testProperty "sf_drop" sf_drop,+ testProperty "t_drop" t_drop,+ testProperty "tl_drop" tl_drop,+ testProperty "s_take_drop" s_take_drop,+ testProperty "s_take_drop_s" s_take_drop_s,+ testProperty "s_takeWhile" s_takeWhile,+ testProperty "s_takeWhile_s" s_takeWhile_s,+ testProperty "sf_takeWhile" sf_takeWhile,+ testProperty "t_takeWhile" t_takeWhile,+ testProperty "tl_takeWhile" tl_takeWhile,+ testProperty "sf_dropWhile" sf_dropWhile,+ testProperty "s_dropWhile" s_dropWhile,+ testProperty "s_dropWhile_s" s_dropWhile_s,+ testProperty "t_dropWhile" t_dropWhile,+ testProperty "tl_dropWhile" tl_dropWhile,+ testProperty "t_dropWhileEnd" t_dropWhileEnd,+ testProperty "tl_dropWhileEnd" tl_dropWhileEnd,+ testProperty "t_dropAround" t_dropAround,+ testProperty "tl_dropAround" tl_dropAround,+ testProperty "t_stripStart" t_stripStart,+ testProperty "tl_stripStart" tl_stripStart,+ testProperty "t_stripEnd" t_stripEnd,+ testProperty "tl_stripEnd" tl_stripEnd,+ testProperty "t_strip" t_strip,+ testProperty "tl_strip" tl_strip,+ testProperty "t_splitAt" t_splitAt,+ testProperty "tl_splitAt" tl_splitAt,+ testProperty "t_span" t_span,+ testProperty "tl_span" tl_span,+ testProperty "t_breakOn_id" t_breakOn_id,+ testProperty "tl_breakOn_id" tl_breakOn_id,+ testProperty "t_breakOn_start" t_breakOn_start,+ testProperty "tl_breakOn_start" tl_breakOn_start,+ testProperty "t_breakOnEnd_end" t_breakOnEnd_end,+ testProperty "tl_breakOnEnd_end" tl_breakOnEnd_end,+ testProperty "t_break" t_break,+ testProperty "tl_break" tl_break,+ testProperty "t_group" t_group,+ testProperty "tl_group" tl_group,+ testProperty "t_groupBy" t_groupBy,+ testProperty "tl_groupBy" tl_groupBy,+ testProperty "t_inits" t_inits,+ testProperty "tl_inits" tl_inits,+ testProperty "t_tails" t_tails,+ testProperty "tl_tails" tl_tails+ ],++ testGroup "breaking many" [+ testProperty "t_findAppendId" t_findAppendId,+ testProperty "tl_findAppendId" tl_findAppendId,+ testProperty "t_findContains" t_findContains,+ testProperty "tl_findContains" tl_findContains,+ testProperty "sl_filterCount" sl_filterCount,+ testProperty "t_findCount" t_findCount,+ testProperty "tl_findCount" tl_findCount,+ testProperty "t_splitOn_split" t_splitOn_split,+ testProperty "tl_splitOn_split" tl_splitOn_split,+ testProperty "t_splitOn_i" t_splitOn_i,+ testProperty "tl_splitOn_i" tl_splitOn_i,+ testProperty "t_split" t_split,+ testProperty "t_split_count" t_split_count,+ testProperty "t_split_splitOn" t_split_splitOn,+ testProperty "tl_split" tl_split,+ testProperty "t_chunksOf_same_lengths" t_chunksOf_same_lengths,+ testProperty "t_chunksOf_length" t_chunksOf_length,+ testProperty "tl_chunksOf" tl_chunksOf+ ],++ testGroup "lines and words" [+ testProperty "t_lines" t_lines,+ testProperty "tl_lines" tl_lines,+ --testProperty "t_lines'" t_lines',+ testProperty "t_words" t_words,+ testProperty "tl_words" tl_words,+ testProperty "t_unlines" t_unlines,+ testProperty "tl_unlines" tl_unlines,+ testProperty "t_unwords" t_unwords,+ testProperty "tl_unwords" tl_unwords+ ]+ ],++ testGroup "predicates" [+ testProperty "s_isPrefixOf" s_isPrefixOf,+ testProperty "sf_isPrefixOf" sf_isPrefixOf,+ testProperty "t_isPrefixOf" t_isPrefixOf,+ testProperty "tl_isPrefixOf" tl_isPrefixOf,+ testProperty "t_isSuffixOf" t_isSuffixOf,+ testProperty "tl_isSuffixOf" tl_isSuffixOf,+ testProperty "t_isInfixOf" t_isInfixOf,+ testProperty "tl_isInfixOf" tl_isInfixOf,++ testGroup "view" [+ testProperty "t_stripPrefix" t_stripPrefix,+ testProperty "tl_stripPrefix" tl_stripPrefix,+ testProperty "t_stripSuffix" t_stripSuffix,+ testProperty "tl_stripSuffix" tl_stripSuffix,+ testProperty "t_commonPrefixes" t_commonPrefixes,+ testProperty "tl_commonPrefixes" tl_commonPrefixes+ ]+ ],++ testGroup "searching" [+ testProperty "sf_elem" sf_elem,+ testProperty "sf_filter" sf_filter,+ testProperty "t_filter" t_filter,+ testProperty "tl_filter" tl_filter,+ testProperty "sf_findBy" sf_findBy,+ testProperty "t_find" t_find,+ testProperty "tl_find" tl_find,+ testProperty "t_partition" t_partition,+ testProperty "tl_partition" tl_partition+ ],++ testGroup "indexing" [+ testProperty "sf_index" sf_index,+ testProperty "t_index" t_index,+ testProperty "tl_index" tl_index,+ testProperty "t_findIndex" t_findIndex,+ testProperty "t_count" t_count,+ testProperty "tl_count" tl_count,+ testProperty "t_indices" t_indices,+ testProperty "tl_indices" tl_indices,+ testProperty "t_indices_occurs" t_indices_occurs+ ],++ testGroup "zips" [+ testProperty "t_zip" t_zip,+ testProperty "tl_zip" tl_zip,+ testProperty "sf_zipWith" sf_zipWith,+ testProperty "t_zipWith" t_zipWith,+ testProperty "tl_zipWith" tl_zipWith+ ],++ testGroup "regressions" [+ testProperty "s_filter_eq" s_filter_eq+ ],++ testGroup "shifts" [+ testProperty "shiftL_Int" shiftL_Int,+ testProperty "shiftL_Word16" shiftL_Word16,+ testProperty "shiftL_Word32" shiftL_Word32,+ testProperty "shiftR_Int" shiftR_Int,+ testProperty "shiftR_Word16" shiftR_Word16,+ testProperty "shiftR_Word32" shiftR_Word32+ ],++ testGroup "builder" [+ testProperty "tb_associative" tb_associative,+ testGroup "decimal" [+ testProperty "tb_decimal_int" tb_decimal_int,+ testProperty "tb_decimal_int8" tb_decimal_int8,+ testProperty "tb_decimal_int16" tb_decimal_int16,+ testProperty "tb_decimal_int32" tb_decimal_int32,+ testProperty "tb_decimal_int64" tb_decimal_int64,+ testProperty "tb_decimal_integer" tb_decimal_integer,+ testProperty "tb_decimal_word" tb_decimal_word,+ testProperty "tb_decimal_word8" tb_decimal_word8,+ testProperty "tb_decimal_word16" tb_decimal_word16,+ testProperty "tb_decimal_word32" tb_decimal_word32,+ testProperty "tb_decimal_word64" tb_decimal_word64+ ],+ testGroup "hexadecimal" [+ testProperty "tb_hexadecimal_int" tb_hexadecimal_int,+ testProperty "tb_hexadecimal_int8" tb_hexadecimal_int8,+ testProperty "tb_hexadecimal_int16" tb_hexadecimal_int16,+ testProperty "tb_hexadecimal_int32" tb_hexadecimal_int32,+ testProperty "tb_hexadecimal_int64" tb_hexadecimal_int64,+ testProperty "tb_hexadecimal_integer" tb_hexadecimal_integer,+ testProperty "tb_hexadecimal_word" tb_hexadecimal_word,+ testProperty "tb_hexadecimal_word8" tb_hexadecimal_word8,+ testProperty "tb_hexadecimal_word16" tb_hexadecimal_word16,+ testProperty "tb_hexadecimal_word32" tb_hexadecimal_word32,+ testProperty "tb_hexadecimal_word64" tb_hexadecimal_word64+ ],+ testGroup "realfloat" [+ testProperty "tb_realfloat_double" tb_realfloat_double,+ testProperty "tb_realfloat_float" tb_realfloat_float+ ],+ testProperty "tb_fromText" tb_fromText,+ testProperty "tb_singleton" tb_singleton+ ],++ testGroup "read" [+ testProperty "t_decimal" t_decimal,+ testProperty "tl_decimal" tl_decimal,+ testProperty "t_hexadecimal" t_hexadecimal,+ testProperty "tl_hexadecimal" tl_hexadecimal,+ testProperty "t_double" t_double,+ testProperty "tl_double" tl_double,+ testProperty "t_rational" t_rational,+ testProperty "tl_rational" tl_rational+ ],++ {-+ testGroup "input-output" [+ testProperty "t_write_read" t_write_read,+ testProperty "tl_write_read" tl_write_read,+ testProperty "t_write_read_line" t_write_read_line,+ testProperty "tl_write_read_line" tl_write_read_line+ -- These tests are subject to I/O race conditions when run under+ -- test-framework-quickcheck2.+ -- testProperty "t_put_get" t_put_get+ -- testProperty "tl_put_get" tl_put_get+ ],+ -}++ testGroup "lowlevel" [+ testProperty "t_dropWord16" t_dropWord16,+ testProperty "t_takeWord16" t_takeWord16,+ testProperty "t_take_drop_16" t_take_drop_16,+ testProperty "t_use_from" t_use_from+ ]+ ]
+ tests/Tests/QuickCheckUtils.hs view
@@ -0,0 +1,337 @@+-- | This module provides quickcheck utilities, e.g. arbitrary and show+-- instances, and comparison functions, so we can focus on the actual properties+-- in the 'Tests.Properties' module.+--+{-# LANGUAGE CPP, FlexibleInstances, TypeSynonymInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Tests.QuickCheckUtils+ (+ genUnicode+ , unsquare+ , smallArbitrary++ , NotEmpty (..)++ , Small (..)+ , small++ , integralRandomR++ , DecodeErr (..)++ , Stringy (..)+ , eq+ , eqP++ , Encoding (..)++ , write_read+ ) where++import Control.Arrow (first, (***))+import Control.DeepSeq (NFData (..), deepseq)+import Control.Exception (bracket)+import Data.Bits ((.&.))+import Data.Char (chr)+import Data.Word (Word8, Word16)+import Data.String (IsString, fromString)+import Data.Text.Foreign (I16)+import Debug.Trace (trace)+import System.Random (Random (..), RandomGen)+import Test.QuickCheck hiding ((.&.))+import Test.QuickCheck.Monadic (assert, monadicIO, run)+import qualified Data.ByteString as B+import qualified Data.Text as T+import qualified Data.Text.Encoding.Error as T+import qualified Data.Text.Fusion as TF+import qualified Data.Text.Fusion.Common as TF+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Fusion as TLF+import qualified Data.Text.Lazy.Internal as TL+import qualified System.IO as IO++import Tests.Utils++instance Random I16 where+ randomR = integralRandomR+ random = randomR (minBound,maxBound)++instance Arbitrary I16 where+ arbitrary = choose (minBound,maxBound)++instance Arbitrary B.ByteString where+ arbitrary = B.pack `fmap` arbitrary++genUnicode :: IsString a => Gen a+genUnicode = fmap fromString string where+ string = sized $ \n ->+ do k <- choose (0,n)+ sequence [ char | _ <- [1..k] ]++ excluding :: [a -> Bool] -> Gen a -> Gen a+ excluding bad gen = loop+ where+ loop = do+ x <- gen+ if or (map ($ x) bad)+ then loop+ else return x++ reserved = [lowSurrogate, highSurrogate, noncharacter]+ lowSurrogate c = c >= 0xDC00 && c <= 0xDFFF+ highSurrogate c = c >= 0xD800 && c <= 0xDBFF+ noncharacter c = masked == 0xFFFE || masked == 0xFFFF+ where+ masked = c .&. 0xFFFF++ ascii = choose (0,0x7F)+ plane0 = choose (0xF0, 0xFFFF)+ plane1 = oneof [ choose (0x10000, 0x10FFF)+ , choose (0x11000, 0x11FFF)+ , choose (0x12000, 0x12FFF)+ , choose (0x13000, 0x13FFF)+ , choose (0x1D000, 0x1DFFF)+ , choose (0x1F000, 0x1FFFF)+ ]+ plane2 = oneof [ choose (0x20000, 0x20FFF)+ , choose (0x21000, 0x21FFF)+ , choose (0x22000, 0x22FFF)+ , choose (0x23000, 0x23FFF)+ , choose (0x24000, 0x24FFF)+ , choose (0x25000, 0x25FFF)+ , choose (0x26000, 0x26FFF)+ , choose (0x27000, 0x27FFF)+ , choose (0x28000, 0x28FFF)+ , choose (0x29000, 0x29FFF)+ , choose (0x2A000, 0x2AFFF)+ , choose (0x2B000, 0x2BFFF)+ , choose (0x2F000, 0x2FFFF)+ ]+ plane14 = choose (0xE0000, 0xE0FFF)+ planes = [ascii, plane0, plane1, plane2, plane14]++ char = chr `fmap` excluding reserved (oneof planes)++-- For tests that have O(n^2) running times or input sizes, resize+-- their inputs to the square root of the originals.+unsquare :: (Arbitrary a, Show a, Testable b) => (a -> b) -> Property+unsquare = forAll smallArbitrary++smallArbitrary :: (Arbitrary a, Show a) => Gen a+smallArbitrary = sized $ \n -> resize (smallish n) arbitrary+ where smallish = round . (sqrt :: Double -> Double) . fromIntegral . abs++instance Arbitrary T.Text where+ arbitrary = T.pack `fmap` arbitrary++instance Arbitrary TL.Text where+ arbitrary = (TL.fromChunks . map notEmpty) `fmap` smallArbitrary++newtype NotEmpty a = NotEmpty { notEmpty :: a }+ deriving (Eq, Ord)++instance Show a => Show (NotEmpty a) where+ show (NotEmpty a) = show a++instance Functor NotEmpty where+ fmap f (NotEmpty a) = NotEmpty (f a)++instance Arbitrary a => Arbitrary (NotEmpty [a]) where+ arbitrary = sized (\n -> NotEmpty `fmap` (choose (1,n+1) >>= vector))++instance Arbitrary (NotEmpty T.Text) where+ arbitrary = (fmap T.pack) `fmap` arbitrary++instance Arbitrary (NotEmpty TL.Text) where+ arbitrary = (fmap TL.pack) `fmap` arbitrary++instance Arbitrary (NotEmpty B.ByteString) where+ arbitrary = (fmap B.pack) `fmap` arbitrary++data Small = S0 | S1 | S2 | S3 | S4 | S5 | S6 | S7+ | S8 | S9 | S10 | S11 | S12 | S13 | S14 | S15+ | S16 | S17 | S18 | S19 | S20 | S21 | S22 | S23+ | S24 | S25 | S26 | S27 | S28 | S29 | S30 | S31+ deriving (Eq, Ord, Enum, Bounded)++small :: Integral a => Small -> a+small = fromIntegral . fromEnum++intf :: (Int -> Int -> Int) -> Small -> Small -> Small+intf f a b = toEnum ((fromEnum a `f` fromEnum b) `mod` 32)++instance Show Small where+ show = show . fromEnum++instance Read Small where+ readsPrec n = map (first toEnum) . readsPrec n++instance Num Small where+ fromInteger = toEnum . fromIntegral+ signum _ = 1+ abs = id+ (+) = intf (+)+ (-) = intf (-)+ (*) = intf (*)++instance Real Small where+ toRational = toRational . fromEnum++instance Integral Small where+ toInteger = toInteger . fromEnum+ quotRem a b = (toEnum x, toEnum y)+ where (x, y) = fromEnum a `quotRem` fromEnum b++instance Random Small where+ randomR = integralRandomR+ random = randomR (minBound,maxBound)++instance Arbitrary Small where+ arbitrary = choose (minBound,maxBound)++integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)+integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,+ fromIntegral b :: Integer) g of+ (x,h) -> (fromIntegral x, h)++data DecodeErr = DE String T.OnDecodeError++instance Show DecodeErr where+ show (DE d _) = "DE " ++ d++instance Arbitrary DecodeErr where+ arbitrary = oneof [ return $ DE "lenient" T.lenientDecode+ , return $ DE "ignore" T.ignore+ , return $ DE "strict" T.strictDecode+ , DE "replace" `fmap` arbitrary ]++class Stringy s where+ packS :: String -> s+ unpackS :: s -> String+ splitAtS :: Int -> s -> (s,s)+ packSChunkSize :: Int -> String -> s+ packSChunkSize _ = packS++instance Stringy String where+ packS = id+ unpackS = id+ splitAtS = splitAt++instance Stringy (TF.Stream Char) where+ packS = TF.streamList+ unpackS = TF.unstreamList+ splitAtS n s = (TF.take n s, TF.drop n s)++instance Stringy T.Text where+ packS = T.pack+ unpackS = T.unpack+ splitAtS = T.splitAt++instance Stringy TL.Text where+ packSChunkSize k = TLF.unstreamChunks k . TF.streamList+ packS = TL.pack+ unpackS = TL.unpack+ splitAtS = ((TL.lazyInvariant *** TL.lazyInvariant) .) .+ TL.splitAt . fromIntegral++-- Do two functions give the same answer?+eq :: (Eq a, Show a) => (t -> a) -> (t -> a) -> t -> Bool+eq a b s = a s =^= b s++-- What about with the RHS packed?+eqP :: (Eq a, Show a, Stringy s) =>+ (String -> a) -> (s -> a) -> String -> Word8 -> Bool+eqP f g s w = eql "orig" (f s) (g t) &&+ eql "mini" (f s) (g mini) &&+ eql "head" (f sa) (g ta) &&+ eql "tail" (f sb) (g tb)+ where t = packS s+ mini = packSChunkSize 10 s+ (sa,sb) = splitAt m s+ (ta,tb) = splitAtS m t+ l = length s+ m | l == 0 = n+ | otherwise = n `mod` l+ n = fromIntegral w+ eql d a b+ | a =^= b = True+ | otherwise = trace (d ++ ": " ++ show a ++ " /= " ++ show b) False++-- Work around lack of Show instance for TextEncoding.+data Encoding = E String IO.TextEncoding++instance Show Encoding where show (E n _) = "utf" ++ n++instance Arbitrary Encoding where+ arbitrary = oneof . map return $+ [ E "8" IO.utf8, E "8_bom" IO.utf8_bom, E "16" IO.utf16+ , E "16le" IO.utf16le, E "16be" IO.utf16be, E "32" IO.utf32+ , E "32le" IO.utf32le, E "32be" IO.utf32be+ ]++windowsNewlineMode :: IO.NewlineMode+windowsNewlineMode = IO.NewlineMode+ { IO.inputNL = IO.CRLF, IO.outputNL = IO.CRLF+ }++-- Newline and NewlineMode have standard Show instance from GHC 7 onwards+#if __GLASGOW_HASKELL__ < 700+instance Show IO.Newline where+ show IO.CRLF = "CRLF"+ show IO.LF = "LF"++instance Show IO.NewlineMode where+ show (IO.NewlineMode i o) = "NewlineMode { inputNL = " ++ show i +++ ", outputNL = " ++ show o ++ " }"+# endif++instance Arbitrary IO.NewlineMode where+ arbitrary = oneof . map return $+ [ IO.noNewlineTranslation, IO.universalNewlineMode, IO.nativeNewlineMode+ , windowsNewlineMode+ ]++instance Arbitrary IO.BufferMode where+ arbitrary = oneof [ return IO.NoBuffering,+ return IO.LineBuffering,+ return (IO.BlockBuffering Nothing),+ (IO.BlockBuffering . Just . (+1) . fromIntegral) `fmap`+ (arbitrary :: Gen Word16) ]++-- This test harness is complex! What property are we checking?+--+-- Reading after writing a multi-line file should give the same+-- results as were written.+--+-- What do we vary while checking this property?+-- * The lines themselves, scrubbed to contain neither CR nor LF. (By+-- working with a list of lines, we ensure that the data will+-- sometimes contain line endings.)+-- * Encoding.+-- * Newline translation mode.+-- * Buffering.+write_read :: (NFData a, Eq a)+ => ([b] -> a)+ -> ((Char -> Bool) -> a -> b)+ -> (IO.Handle -> a -> IO ())+ -> (IO.Handle -> IO a)+ -> Encoding+ -> IO.NewlineMode+ -> IO.BufferMode+ -> [a]+ -> Property+write_read unline filt writer reader (E _ _) nl buf ts =+ monadicIO $ assert . (==t) =<< run act+ where t = unline . map (filt (not . (`elem` "\r\n"))) $ ts+ act = withTempFile $ \path h -> do+ -- hSetEncoding h enc+ IO.hSetNewlineMode h nl+ IO.hSetBuffering h buf+ () <- writer h t+ IO.hClose h+ bracket (IO.openFile path IO.ReadMode) IO.hClose $ \h' -> do+ -- hSetEncoding h' enc+ IO.hSetNewlineMode h' nl+ IO.hSetBuffering h' buf+ r <- reader h'+ r `deepseq` return r
+ tests/Tests/Regressions.hs view
@@ -0,0 +1,57 @@+-- | Regression tests for specific bugs.+--+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}+module Tests.Regressions+ (+ tests+ ) where++import Control.Exception (SomeException, handle)+import System.IO+import Test.HUnit (assertFailure)+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as LB+import qualified Data.Text as T+import qualified Data.Text.IO as T+import qualified Data.Text.Lazy as LT+import qualified Data.Text.Lazy.Encoding as LE+import qualified Test.Framework as F+import qualified Test.Framework.Providers.HUnit as F++import Tests.Utils (withTempFile)++-- Reported by Michael Snoyman: UTF-8 encoding a large lazy bytestring+-- caused either a segfault or attempt to allocate a negative number+-- of bytes.+lazy_encode_crash :: IO ()+lazy_encode_crash = withTempFile $ \ _ h ->+ LB.hPut h . LE.encodeUtf8 . LT.pack . replicate 100000 $ 'a'++-- Reported by Pieter Laeremans: attempting to read an incorrectly+-- encoded file can result in a crash in the RTS (i.e. not merely an+-- exception).+hGetContents_crash :: IO ()+hGetContents_crash = withTempFile $ \ path h -> do+ B.hPut h (B.pack [0x78, 0xc4 ,0x0a]) >> hClose h+ h' <- openFile path ReadMode+ hSetEncoding h' utf8+ handle (\(_::SomeException) -> return ()) $+ T.hGetContents h' >> assertFailure "T.hGetContents should crash"++-- Reported by Ian Lynagh: attempting to allocate a sufficiently large+-- string (via either Array.new or Text.replicate) could result in an+-- integer overflow.+replicate_crash :: IO ()+replicate_crash = handle (\(_::SomeException) -> return ()) $+ T.replicate (2^power) "0123456789abcdef" `seq`+ assertFailure "T.replicate should crash"+ where+ power | maxBound == (2147483647::Int) = 28+ | otherwise = 60 :: Int++tests :: F.Test+tests = F.testGroup "Regressions"+ [ F.testCase "hGetContents_crash" hGetContents_crash+ , F.testCase "lazy_encode_crash" lazy_encode_crash+ , F.testCase "replicate_crash" replicate_crash+ ]
+ tests/Tests/SlowFunctions.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE BangPatterns #-}+module Tests.SlowFunctions+ (+ indices+ , splitOn+ ) where++import qualified Data.Text as T+import Data.Text.Internal (Text(..))+import Data.Text.Unsafe (iter_, unsafeHead, unsafeTail)++indices :: T.Text -- ^ Substring to search for (@needle@)+ -> T.Text -- ^ Text to search in (@haystack@)+ -> [Int]+indices needle@(Text _narr _noff nlen) haystack@(Text harr hoff hlen)+ | T.null needle = []+ | otherwise = scan 0+ where+ scan i | i >= hlen = []+ | needle `T.isPrefixOf` t = i : scan (i+nlen)+ | otherwise = scan (i+d)+ where t = Text harr (hoff+i) (hlen-i)+ d = iter_ haystack i++splitOn :: T.Text -- ^ Text to split on+ -> T.Text -- ^ Input text+ -> [T.Text]+splitOn pat src0+ | T.null pat = error "splitOn: empty"+ | l == 1 = T.split (== (unsafeHead pat)) src0+ | otherwise = go src0+ where+ l = T.length pat+ go src = search 0 src+ where+ search !n !s+ | T.null s = [src] -- not found+ | pat `T.isPrefixOf` s = T.take n src : go (T.drop l s)+ | otherwise = search (n+1) (unsafeTail s)
+ tests/Tests/Utils.hs view
@@ -0,0 +1,52 @@+-- | Miscellaneous testing utilities+--+{-# LANGUAGE ScopedTypeVariables #-}+module Tests.Utils+ (+ (=^=)+ , withRedirect+ , withTempFile+ ) where++import Control.Exception (SomeException, bracket, bracket_, evaluate, try)+import Control.Monad (when)+import Debug.Trace (trace)+import GHC.IO.Handle.Internals (withHandle)+import System.Directory (removeFile)+import System.IO (Handle, hClose, hFlush, hIsOpen, hIsWritable, openTempFile)+import System.IO.Unsafe (unsafePerformIO)++-- Ensure that two potentially bottom values (in the sense of crashing+-- for some inputs, not looping infinitely) either both crash, or both+-- give comparable results for some input.+(=^=) :: (Eq a, Show a) => a -> a -> Bool+i =^= j = unsafePerformIO $ do+ x <- try (evaluate i)+ y <- try (evaluate j)+ case (x,y) of+ (Left (_ :: SomeException), Left (_ :: SomeException))+ -> return True+ (Right a, Right b) -> return (a == b)+ e -> trace ("*** Divergence: " ++ show e) return False+infix 4 =^=+{-# NOINLINE (=^=) #-}++withTempFile :: (FilePath -> Handle -> IO a) -> IO a+withTempFile = bracket (openTempFile "." "crashy.txt") cleanupTemp . uncurry+ where+ cleanupTemp (path,h) = do+ open <- hIsOpen h+ when open (hClose h)+ removeFile path++withRedirect :: Handle -> Handle -> IO a -> IO a+withRedirect tmp h = bracket_ swap swap+ where+ whenM p a = p >>= (`when` a)+ swap = do+ whenM (hIsOpen tmp) $ whenM (hIsWritable tmp) $ hFlush tmp+ whenM (hIsOpen h) $ whenM (hIsWritable h) $ hFlush h+ withHandle "spam" tmp $ \tmph -> do+ hh <- withHandle "spam" h $ \hh ->+ return (tmph,hh)+ return (hh,())
− tests/benchmarks/Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
− tests/benchmarks/cbits/time_iconv.c
@@ -1,35 +0,0 @@-#include <iconv.h>-#include <stdlib.h>-#include <stdio.h>-#include <stdint.h>--int time_iconv(char *srcbuf, size_t srcbufsize)-{- uint16_t *destbuf = NULL;- size_t destbufsize;- static uint16_t *origdestbuf;- static size_t origdestbufsize;- iconv_t ic = (iconv_t) -1;- int ret = 0;-- if (ic == (iconv_t) -1) {- ic = iconv_open("UTF-16LE", "UTF-8");- if (ic == (iconv_t) -1) {- ret = -1;- goto done;- }- }- - destbufsize = srcbufsize * sizeof(uint16_t);- if (destbufsize > origdestbufsize) {- free(origdestbuf);- origdestbuf = destbuf = malloc(origdestbufsize = destbufsize);- } else {- destbuf = origdestbuf;- }-- iconv(ic, &srcbuf, &srcbufsize, (char**) &destbuf, &destbufsize);-- done:- return ret;-}
− tests/benchmarks/python/cut.py
@@ -1,12 +0,0 @@-#!/usr/bin/env python--import utils, sys, codecs--def cut(filename, l, r):- content = open(filename, encoding='utf-8')- for line in content:- print(line[l:r])--for f in sys.argv[1:]:- t = utils.benchmark(lambda: cut(f, 20, 40))- sys.stderr.write('{0}: {1}\n'.format(f, t))
− tests/benchmarks/python/sort.py
@@ -1,13 +0,0 @@-#!/usr/bin/env python--import utils, sys, codecs--def sort(filename):- content = open(filename, encoding='utf-8').read()- lines = content.splitlines()- lines.sort()- print('\n'.join(lines))--for f in sys.argv[1:]:- t = utils.benchmark(lambda: sort(f))- sys.stderr.write('{0}: {1}\n'.format(f, t))
− tests/benchmarks/python/strip_tags.py
@@ -1,25 +0,0 @@-#!/usr/bin/env python--import utils, sys--def strip_tags(filename):- string = open(filename, encoding='utf-8').read()-- d = 0- out = []-- for c in string:- if c == '<': d += 1-- if d > 0:- out += ' '- else:- out += c-- if c == '>': d -= 1-- print(''.join(out))--for f in sys.argv[1:]:- t = utils.benchmark(lambda: strip_tags(f))- sys.stderr.write('{0}: {1}\n'.format(f, t))
− tests/benchmarks/python/utils.py
@@ -1,18 +0,0 @@-#!/usr/bin/env python--import sys, time--def benchmark_once(f):- start = time.time()- f()- end = time.time()- return end - start--def benchmark(f):- runs = 100- total = 0.0- for i in range(runs):- result = benchmark_once(f)- sys.stderr.write('Run {0}: {1}\n'.format(i, result))- total += result- return total / runs
− tests/benchmarks/ruby/cut.rb
@@ -1,16 +0,0 @@-#!/usr/bin/env ruby--require './utils.rb'--def cut(filename, l, r)- File.open(filename, 'r:utf-8') do |file|- file.each_line do |line|- puts line[l, r - l]- end- end-end--ARGV.each do |f|- t = benchmark { cut(f, 20, 40) }- STDERR.puts "#{f}: #{t}"-end
− tests/benchmarks/ruby/fold.rb
@@ -1,50 +0,0 @@-#!/usr/bin/env ruby--require './utils.rb'--def fold(filename, max_width)- File.open(filename, 'r:utf-8') do |file|- # Words in this paragraph- paragraph = []-- file.each_line do |line|- # If we encounter an empty line, we reformat and dump the current- # paragraph- if line.strip.empty?- puts fold_paragraph(paragraph, max_width)- puts- paragraph = []- # Otherwise, we append the words found in the line to the paragraph- else- paragraph.concat line.split- end- end-- # Last paragraph- puts fold_paragraph(paragraph, max_width) unless paragraph.empty?- end-end--# Fold a single paragraph to the desired width-def fold_paragraph(paragraph, max_width)- # Gradually build our output- str, *rest = paragraph- width = str.length-- rest.each do |word|- if width + word.length + 1 <= max_width- str << ' ' << word- width += word.length + 1- else- str << "\n" << word- width = word.length- end- end-- str-end--ARGV.each do |f|- t = benchmark { fold(f, 80) }- STDERR.puts "#{f}: #{t}"-end
− tests/benchmarks/ruby/sort.rb
@@ -1,15 +0,0 @@-#!/usr/bin/env ruby--require './utils.rb'--def sort(filename)- File.open(filename, 'r:utf-8') do |file|- content = file.read- puts content.lines.sort.join- end-end--ARGV.each do |f|- t = benchmark { sort(f) }- STDERR.puts "#{f}: #{t}"-end
− tests/benchmarks/ruby/strip_tags.rb
@@ -1,22 +0,0 @@-#!/usr/bin/env ruby--require './utils.rb'--def strip_tags(filename)- File.open(filename, 'r:utf-8') do |file|- str = file.read-- d = 0-- str.each_char do |c|- d += 1 if c == '<'- putc(if d > 0 then ' ' else c end)- d -= 1 if c == '>'- end- end-end--ARGV.each do |f|- t = benchmark { strip_tags(f) }- STDERR.puts "#{f}: #{t}"-end
− tests/benchmarks/ruby/utils.rb
@@ -1,14 +0,0 @@-require 'benchmark'--def benchmark(&block)- runs = 100- total = 0-- runs.times do |i|- result = Benchmark.measure(&block).total- $stderr.puts "Run #{i}: #{result}"- total += result- end-- total / runs -end
− tests/benchmarks/src/Data/Text/Benchmarks.hs
@@ -1,73 +0,0 @@--- | Main module to run the micro benchmarks----{-# LANGUAGE OverloadedStrings #-}-module Main- ( main- ) where--import Criterion.Main (Benchmark, defaultMain, bgroup)-import System.FilePath ((</>))-import System.IO (IOMode (WriteMode), openFile, hSetEncoding, utf8)--import qualified Data.Text.Benchmarks.Builder as Builder-import qualified Data.Text.Benchmarks.DecodeUtf8 as DecodeUtf8-import qualified Data.Text.Benchmarks.EncodeUtf8 as EncodeUtf8-import qualified Data.Text.Benchmarks.Equality as Equality-import qualified Data.Text.Benchmarks.FileRead as FileRead-import qualified Data.Text.Benchmarks.FoldLines as FoldLines-import qualified Data.Text.Benchmarks.Pure as Pure-import qualified Data.Text.Benchmarks.ReadNumbers as ReadNumbers-import qualified Data.Text.Benchmarks.Replace as Replace-import qualified Data.Text.Benchmarks.Search as Search-import qualified Data.Text.Benchmarks.Stream as Stream-import qualified Data.Text.Benchmarks.WordFrequencies as WordFrequencies--import qualified Data.Text.Benchmarks.Programs.BigTable as Programs.BigTable-import qualified Data.Text.Benchmarks.Programs.Cut as Programs.Cut-import qualified Data.Text.Benchmarks.Programs.Fold as Programs.Fold-import qualified Data.Text.Benchmarks.Programs.Sort as Programs.Sort-import qualified Data.Text.Benchmarks.Programs.StripTags as Programs.StripTags-import qualified Data.Text.Benchmarks.Programs.Throughput as Programs.Throughput--main :: IO ()-main = benchmarks >>= defaultMain--benchmarks :: IO [Benchmark]-benchmarks = do- sink <- openFile "/dev/null" WriteMode- hSetEncoding sink utf8-- -- Traditional benchmarks- bs <- sequence- [ Builder.benchmark- , DecodeUtf8.benchmark "html" (tf "libya-chinese.html")- , DecodeUtf8.benchmark "xml" (tf "yiwiki.xml")- , DecodeUtf8.benchmark "ascii" (tf "ascii.txt")- , DecodeUtf8.benchmark "russian" (tf "russian.txt")- , DecodeUtf8.benchmark "japanese" (tf "japanese.txt")- , EncodeUtf8.benchmark "επανάληψη 竺法蘭共譯"- , Equality.benchmark (tf "japanese.txt")- , FileRead.benchmark (tf "russian.txt")- , FoldLines.benchmark (tf "russian.txt")- , Pure.benchmark (tf "japanese.txt")- , ReadNumbers.benchmark (tf "numbers.txt")- , Replace.benchmark (tf "russian.txt") "принимая" "своем"- , Search.benchmark (tf "russian.txt") "принимая"- , Stream.benchmark (tf "russian.txt")- , WordFrequencies.benchmark (tf "russian.txt")- ]-- -- Program-like benchmarks- ps <- bgroup "Programs" `fmap` sequence- [ Programs.BigTable.benchmark sink- , Programs.Cut.benchmark (tf "russian.txt") sink 20 40- , Programs.Fold.benchmark (tf "russian.txt") sink- , Programs.Sort.benchmark (tf "russian.txt") sink- , Programs.StripTags.benchmark (tf "yiwiki.xml") sink- , Programs.Throughput.benchmark (tf "russian.txt") sink- ]-- return $ bs ++ [ps]- where- -- Location of a test file- tf = ("../text-test-data" </>)
− tests/benchmarks/src/Data/Text/Benchmarks/Builder.hs
@@ -1,48 +0,0 @@--- | Testing the internal builder monoid------ Tested in this benchmark:------ * Concatenating many small strings using a builder----{-# LANGUAGE OverloadedStrings #-}-module Data.Text.Benchmarks.Builder- ( benchmark- ) where--import Criterion (Benchmark, bgroup, bench, nf)-import Data.Binary.Builder as B-import Data.ByteString.Char8 ()-import Data.Monoid (mconcat)-import qualified Blaze.ByteString.Builder as Blaze-import qualified Blaze.ByteString.Builder.Char.Utf8 as Blaze-import qualified Data.ByteString as SB-import qualified Data.ByteString.Lazy as LB-import qualified Data.Text as T-import qualified Data.Text.Lazy as LT-import qualified Data.Text.Lazy.Builder as LTB--benchmark :: IO Benchmark-benchmark = return $ bgroup "Builder"- [ bench "LazyText" $ nf- (LT.length . LTB.toLazyText . mconcat . map LTB.fromText) texts- , bench "Binary" $ nf- (LB.length . B.toLazyByteString . mconcat . map B.fromByteString)- byteStrings- , bench "Blaze" $ nf- (LB.length . Blaze.toLazyByteString . mconcat . map Blaze.fromString)- strings- ]--texts :: [T.Text]-texts = take 200000 $ cycle ["foo", "λx", "由の"]-{-# NOINLINE texts #-}---- Note that the non-ascii characters will be chopped-byteStrings :: [SB.ByteString]-byteStrings = take 200000 $ cycle ["foo", "λx", "由の"]-{-# NOINLINE byteStrings #-}---- Note that the non-ascii characters will be chopped-strings :: [String]-strings = take 200000 $ cycle ["foo", "λx", "由の"]-{-# NOINLINE strings #-}
− tests/benchmarks/src/Data/Text/Benchmarks/DecodeUtf8.hs
@@ -1,59 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface #-}---- | Test decoding of UTF-8------ Tested in this benchmark:------ * Decoding bytes using UTF-8------ In some tests:------ * Taking the length of the result------ * Taking the init of the result------ The latter are used for testing stream fusion.----module Data.Text.Benchmarks.DecodeUtf8- ( benchmark- ) where--import Foreign.C.Types (CInt, CSize)-import Data.ByteString.Internal (ByteString(..))-import Foreign.Ptr (Ptr, plusPtr)-import Foreign.ForeignPtr (withForeignPtr)-import Data.Word (Word8)-import qualified Criterion as C-import Criterion (Benchmark, bgroup, nf)-import qualified Codec.Binary.UTF8.Generic as U8-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Encoding as TL--benchmark :: String -> FilePath -> IO Benchmark-benchmark kind fp = do- bs <- B.readFile fp- lbs <- BL.readFile fp- let bench name = C.bench (name ++ "+" ++ kind)- return $ bgroup "DecodeUtf8"- [ bench "Strict" $ nf T.decodeUtf8 bs- , bench "IConv" $ iconv bs- , bench "StrictLength" $ nf (T.length . T.decodeUtf8) bs- , bench "StrictInitLength" $ nf (T.length . T.init . T.decodeUtf8) bs- , bench "Lazy" $ nf TL.decodeUtf8 lbs- , bench "LazyLength" $ nf (TL.length . TL.decodeUtf8) lbs- , bench "LazyInitLength" $ nf (TL.length . TL.init . TL.decodeUtf8) lbs- , bench "StrictStringUtf8" $ nf U8.toString bs- , bench "StrictStringUtf8Length" $ nf (length . U8.toString) bs- , bench "LazyStringUtf8" $ nf U8.toString lbs- , bench "LazyStringUtf8Length" $ nf (length . U8.toString) lbs- ]--iconv :: ByteString -> IO CInt-iconv (PS fp off len) = withForeignPtr fp $ \ptr ->- time_iconv (ptr `plusPtr` off) (fromIntegral len)--foreign import ccall unsafe time_iconv :: Ptr Word8 -> CSize -> IO CInt
− tests/benchmarks/src/Data/Text/Benchmarks/EncodeUtf8.hs
@@ -1,33 +0,0 @@--- | UTF-8 encode a text------ Tested in this benchmark:------ * Replicating a string a number of times------ * UTF-8 encoding it----module Data.Text.Benchmarks.EncodeUtf8- ( benchmark- ) where--import Criterion (Benchmark, bgroup, bench, whnf)-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Encoding as TL--benchmark :: String -> IO Benchmark-benchmark string = do- return $ bgroup "EncodeUtf8"- [ bench "Text" $ whnf (B.length . T.encodeUtf8) text- , bench "LazyText" $ whnf (BL.length . TL.encodeUtf8) lazyText- ]- where- -- The string in different formats- text = T.replicate k $ T.pack string- lazyText = TL.replicate (fromIntegral k) $ TL.pack string-- -- Amount- k = 100000
− tests/benchmarks/src/Data/Text/Benchmarks/Equality.hs
@@ -1,38 +0,0 @@--- | Compare a string with a copy of itself that is identical except--- for the last character.------ Tested in this benchmark:------ * Comparison of strings (Eq instance)----module Data.Text.Benchmarks.Equality- ( benchmark- ) where--import Criterion (Benchmark, bgroup, bench, whnf)-import qualified Data.ByteString.Char8 as B-import qualified Data.ByteString.Lazy.Char8 as BL-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Encoding as TL--benchmark :: FilePath -> IO Benchmark-benchmark fp = do- b <- B.readFile fp- bl1 <- BL.readFile fp- -- A lazy bytestring is a list of chunks. When we do not explicitly create two- -- different lazy bytestrings at a different address, the bytestring library- -- will compare the chunk addresses instead of the chunk contents. This is why- -- we read the lazy bytestring twice here.- bl2 <- BL.readFile fp- l <- readFile fp- let t = T.decodeUtf8 b- tl = TL.decodeUtf8 bl1- return $ bgroup "Equality"- [ bench "Text" $ whnf (== T.init t `T.snoc` '\xfffd') t- , bench "LazyText" $ whnf (== TL.init tl `TL.snoc` '\xfffd') tl- , bench "ByteString" $ whnf (== B.init b `B.snoc` '\xfffd') b- , bench "LazyByteString" $ whnf (== BL.init bl2 `BL.snoc` '\xfffd') bl1- , bench "String" $ whnf (== init l ++ "\xfffd") l- ]
− tests/benchmarks/src/Data/Text/Benchmarks/FileRead.hs
@@ -1,33 +0,0 @@--- | Benchmarks simple file reading------ Tested in this benchmark:------ * Reading a file from the disk----module Data.Text.Benchmarks.FileRead- ( benchmark- ) where--import Control.Exception (evaluate)-import Criterion (Benchmark, bgroup, bench)-import qualified Data.ByteString as SB-import qualified Data.ByteString.Lazy as LB-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import qualified Data.Text.IO as T-import qualified Data.Text.Lazy as LT-import qualified Data.Text.Lazy.Encoding as LT-import qualified Data.Text.Lazy.IO as LT--benchmark :: FilePath -> IO Benchmark-benchmark p = return $ bgroup "FileRead"- [ bench "String" $ readFile p >>= evaluate . length- , bench "ByteString" $ SB.readFile p >>= evaluate . SB.length- , bench "LazyByteString" $ LB.readFile p >>= evaluate . LB.length- , bench "Text" $ T.readFile p >>= evaluate . T.length- , bench "LazyText" $ LT.readFile p >>= evaluate . LT.length- , bench "TextByteString" $- SB.readFile p >>= evaluate . T.length . T.decodeUtf8- , bench "LazyTextByteString" $- LB.readFile p >>= evaluate . LT.length . LT.decodeUtf8- ]
− tests/benchmarks/src/Data/Text/Benchmarks/FoldLines.hs
@@ -1,58 +0,0 @@--- | Read a file line-by-line using handles, and perform a fold over the lines.--- The fold is used here to calculate the number of lines in the file.------ Tested in this benchmark:------ * Buffered, line-based IO----{-# LANGUAGE BangPatterns #-}-module Data.Text.Benchmarks.FoldLines- ( benchmark- ) where--import Criterion (Benchmark, bgroup, bench)-import System.IO-import qualified Data.ByteString as B-import qualified Data.Text as T-import qualified Data.Text.IO as T--benchmark :: FilePath -> IO Benchmark-benchmark fp = return $ bgroup "ReadLines"- [ bench "Text" $ withHandle $ foldLinesT (\n _ -> n + 1) (0 :: Int)- , bench "ByteString" $ withHandle $ foldLinesB (\n _ -> n + 1) (0 :: Int)- ]- where- withHandle f = do- h <- openFile fp ReadMode- hSetBuffering h (BlockBuffering (Just 16384))- x <- f h- hClose h- return x---- | Text line fold----foldLinesT :: (a -> T.Text -> a) -> a -> Handle -> IO a-foldLinesT f z0 h = go z0- where- go !z = do- eof <- hIsEOF h- if eof- then return z- else do- l <- T.hGetLine h- let z' = f z l in go z'-{-# INLINE foldLinesT #-}---- | ByteString line fold----foldLinesB :: (a -> B.ByteString -> a) -> a -> Handle -> IO a-foldLinesB f z0 h = go z0- where- go !z = do- eof <- hIsEOF h- if eof- then return z- else do- l <- B.hGetLine h- let z' = f z l in go z'-{-# INLINE foldLinesB #-}
− tests/benchmarks/src/Data/Text/Benchmarks/Pure.hs
@@ -1,474 +0,0 @@--- | Benchmarks various pure functions from the Text library------ Tested in this benchmark:------ * Most pure functions defined the string types----{-# LANGUAGE BangPatterns, GADTs, MagicHash #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-module Data.Text.Benchmarks.Pure- ( benchmark- ) where--import Control.DeepSeq (NFData (..))-import Control.Exception (evaluate)-import Criterion (Benchmark, bgroup, bench, nf)-import Data.Char (toLower, toUpper)-import Data.Monoid (mappend, mempty)-import GHC.Base (Char (..), Int (..), chr#, ord#, (+#))-import qualified Data.ByteString.Char8 as BS-import qualified Data.ByteString.Lazy.Char8 as BL-import qualified Data.ByteString.Lazy.Internal as BL-import qualified Data.ByteString.UTF8 as UTF8-import qualified Data.List as L-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Builder as TB-import qualified Data.Text.Lazy.Encoding as TL--benchmark :: FilePath -> IO Benchmark-benchmark fp = do- -- Evaluate stuff before actually running the benchmark, we don't want to- -- count it here.-- -- ByteString A- bsa <- BS.readFile fp-- -- Text A/B, LazyText A/B- ta <- evaluate $ T.decodeUtf8 bsa- tb <- evaluate $ T.toUpper ta- tla <- evaluate $ TL.fromChunks (T.chunksOf 16376 ta)- tlb <- evaluate $ TL.fromChunks (T.chunksOf 16376 tb)-- -- ByteString B, LazyByteString A/B- bsb <- evaluate $ T.encodeUtf8 tb- bla <- evaluate $ BL.fromChunks (chunksOf 16376 bsa)- blb <- evaluate $ BL.fromChunks (chunksOf 16376 bsb)-- -- String A/B- sa <- evaluate $ UTF8.toString bsa- sb <- evaluate $ T.unpack tb-- -- Lengths- bsa_len <- evaluate $ BS.length bsa- ta_len <- evaluate $ T.length ta- bla_len <- evaluate $ BL.length bla- tla_len <- evaluate $ TL.length tla- sa_len <- evaluate $ L.length sa-- -- Lines- bsl <- evaluate $ BS.lines bsa- bll <- evaluate $ BL.lines bla- tl <- evaluate $ T.lines ta- tll <- evaluate $ TL.lines tla- sl <- evaluate $ L.lines sa-- return $ bgroup "Pure"- [ bgroup "append"- [ benchT $ nf (T.append tb) ta- , benchTL $ nf (TL.append tlb) tla- , benchBS $ nf (BS.append bsb) bsa- , benchBSL $ nf (BL.append blb) bla- , benchS $ nf ((++) sb) sa- ]- , bgroup "concat"- [ benchT $ nf T.concat tl- , benchTL $ nf TL.concat tll- , benchBS $ nf BS.concat bsl- , benchBSL $ nf BL.concat bll- , benchS $ nf L.concat sl- ]- , bgroup "cons"- [ benchT $ nf (T.cons c) ta- , benchTL $ nf (TL.cons c) tla- , benchBS $ nf (BS.cons c) bsa- , benchBSL $ nf (BL.cons c) bla- , benchS $ nf (c:) sa- ]- , bgroup "concatMap"- [ benchT $ nf (T.concatMap (T.replicate 3 . T.singleton)) ta- , benchTL $ nf (TL.concatMap (TL.replicate 3 . TL.singleton)) tla- , benchBS $ nf (BS.concatMap (BS.replicate 3)) bsa- , benchBSL $ nf (BL.concatMap (BL.replicate 3)) bla- , benchS $ nf (L.concatMap (L.replicate 3 . (:[]))) sa- ]- , bgroup "decode"- [ benchT $ nf T.decodeUtf8 bsa- , benchTL $ nf TL.decodeUtf8 bla- , benchBS $ nf BS.unpack bsa- , benchBSL $ nf BL.unpack bla- , benchS $ nf UTF8.toString bsa- ]- , bgroup "drop"- [ benchT $ nf (T.drop (ta_len `div` 3)) ta- , benchTL $ nf (TL.drop (tla_len `div` 3)) tla- , benchBS $ nf (BS.drop (bsa_len `div` 3)) bsa- , benchBSL $ nf (BL.drop (bla_len `div` 3)) bla- , benchS $ nf (L.drop (sa_len `div` 3)) sa- ]- , bgroup "encode"- [ benchT $ nf T.encodeUtf8 ta- , benchTL $ nf TL.encodeUtf8 tla- , benchBS $ nf BS.pack sa- , benchBSL $ nf BL.pack sa- , benchS $ nf UTF8.fromString sa- ]- , bgroup "filter"- [ benchT $ nf (T.filter p0) ta- , benchTL $ nf (TL.filter p0) tla- , benchBS $ nf (BS.filter p0) bsa- , benchBSL $ nf (BL.filter p0) bla- , benchS $ nf (L.filter p0) sa- ]- , bgroup "filter.filter"- [ benchT $ nf (T.filter p1 . T.filter p0) ta- , benchTL $ nf (TL.filter p1 . TL.filter p0) tla- , benchBS $ nf (BS.filter p1 . BS.filter p0) bsa- , benchBSL $ nf (BL.filter p1 . BL.filter p0) bla- , benchS $ nf (L.filter p1 . L.filter p0) sa- ]- , bgroup "foldl'"- [ benchT $ nf (T.foldl' len 0) ta- , benchTL $ nf (TL.foldl' len 0) tla- , benchBS $ nf (BS.foldl' len 0) bsa- , benchBSL $ nf (BL.foldl' len 0) bla- , benchS $ nf (L.foldl' len 0) sa- ]- , bgroup "foldr"- [ benchT $ nf (L.length . T.foldr (:) []) ta- , benchTL $ nf (L.length . TL.foldr (:) []) tla- , benchBS $ nf (L.length . BS.foldr (:) []) bsa- , benchBSL $ nf (L.length . BL.foldr (:) []) bla- , benchS $ nf (L.length . L.foldr (:) []) sa- ]- , bgroup "head"- [ benchT $ nf T.head ta- , benchTL $ nf TL.head tla- , benchBS $ nf BS.head bsa- , benchBSL $ nf BL.head bla- , benchS $ nf L.head sa- ]- , bgroup "init"- [ benchT $ nf T.init ta- , benchTL $ nf TL.init tla- , benchBS $ nf BS.init bsa- , benchBSL $ nf BL.init bla- , benchS $ nf L.init sa- ]- , bgroup "intercalate"- [ benchT $ nf (T.intercalate tsw) tl- , benchTL $ nf (TL.intercalate tlw) tll- , benchBS $ nf (BS.intercalate bsw) bsl- , benchBSL $ nf (BL.intercalate blw) bll- , benchS $ nf (L.intercalate lw) sl- ]- , bgroup "intersperse"- [ benchT $ nf (T.intersperse c) ta- , benchTL $ nf (TL.intersperse c) tla- , benchBS $ nf (BS.intersperse c) bsa- , benchBSL $ nf (BL.intersperse c) bla- , benchS $ nf (L.intersperse c) sa- ]- , bgroup "isInfixOf"- [ benchT $ nf (T.isInfixOf tsw) ta- , benchTL $ nf (TL.isInfixOf tlw) tla- , benchBS $ nf (BS.isInfixOf bsw) bsa- -- no isInfixOf for lazy bytestrings- , benchS $ nf (L.isInfixOf lw) sa- ]- , bgroup "last"- [ benchT $ nf T.last ta- , benchTL $ nf TL.last tla- , benchBS $ nf BS.last bsa- , benchBSL $ nf BL.last bla- , benchS $ nf L.last sa- ]- , bgroup "map"- [ benchT $ nf (T.map f) ta- , benchTL $ nf (TL.map f) tla- , benchBS $ nf (BS.map f) bsa- , benchBSL $ nf (BL.map f) bla- , benchS $ nf (L.map f) sa- ]- , bgroup "mapAccumL"- [ benchT $ nf (T.mapAccumL g 0) ta- , benchTL $ nf (TL.mapAccumL g 0) tla- , benchBS $ nf (BS.mapAccumL g 0) bsa- , benchBSL $ nf (BL.mapAccumL g 0) bla- , benchS $ nf (L.mapAccumL g 0) sa- ]- , bgroup "mapAccumR"- [ benchT $ nf (T.mapAccumR g 0) ta- , benchTL $ nf (TL.mapAccumR g 0) tla- , benchBS $ nf (BS.mapAccumR g 0) bsa- , benchBSL $ nf (BL.mapAccumR g 0) bla- , benchS $ nf (L.mapAccumR g 0) sa- ]- , bgroup "map.map"- [ benchT $ nf (T.map f . T.map f) ta- , benchTL $ nf (TL.map f . TL.map f) tla- , benchBS $ nf (BS.map f . BS.map f) bsa- , benchBSL $ nf (BL.map f . BL.map f) bla- , benchS $ nf (L.map f . L.map f) sa- ]- , bgroup "replicate char"- [ benchT $ nf (T.replicate bsa_len) (T.singleton c)- , benchTL $ nf (TL.replicate (fromIntegral bsa_len)) (TL.singleton c)- , benchBS $ nf (BS.replicate bsa_len) c- , benchBSL $ nf (BL.replicate (fromIntegral bsa_len)) c- , benchS $ nf (L.replicate bsa_len) c- ]- , bgroup "replicate string"- [ benchT $ nf (T.replicate (bsa_len `div` T.length tsw)) tsw- , benchTL $ nf (TL.replicate (fromIntegral bsa_len `div` TL.length tlw)) tlw- , benchS $ nf (replicat (bsa_len `div` T.length tsw)) lw- ]- , bgroup "reverse"- [ benchT $ nf T.reverse ta- , benchTL $ nf TL.reverse tla- , benchBS $ nf BS.reverse bsa- , benchBSL $ nf BL.reverse bla- , benchS $ nf L.reverse sa- ]- , bgroup "take"- [ benchT $ nf (T.take (ta_len `div` 3)) ta- , benchTL $ nf (TL.take (tla_len `div` 3)) tla- , benchBS $ nf (BS.take (bsa_len `div` 3)) bsa- , benchBSL $ nf (BL.take (bla_len `div` 3)) bla- , benchS $ nf (L.take (sa_len `div` 3)) sa- ]- , bgroup "tail"- [ benchT $ nf T.tail ta- , benchTL $ nf TL.tail tla- , benchBS $ nf BS.tail bsa- , benchBSL $ nf BL.tail bla- , benchS $ nf L.tail sa- ]- , bgroup "toLower"- [ benchT $ nf T.toLower ta- , benchTL $ nf TL.toLower tla- , benchBS $ nf (BS.map toLower) bsa- , benchBSL $ nf (BL.map toLower) bla- , benchS $ nf (L.map toLower) sa- ]- , bgroup "toUpper"- [ benchT $ nf T.toUpper ta- , benchTL $ nf TL.toUpper tla- , benchBS $ nf (BS.map toUpper) bsa- , benchBSL $ nf (BL.map toUpper) bla- , benchS $ nf (L.map toUpper) sa- ]- , bgroup "words"- [ benchT $ nf T.words ta- , benchTL $ nf TL.words tla- , benchBS $ nf BS.words bsa- , benchBSL $ nf BL.words bla- , benchS $ nf L.words sa- ]- , bgroup "zipWith"- [ benchT $ nf (T.zipWith min tb) ta- , benchTL $ nf (TL.zipWith min tlb) tla- , benchBS $ nf (BS.zipWith min bsb) bsa- , benchBSL $ nf (BL.zipWith min blb) bla- , benchS $ nf (L.zipWith min sb) sa- ]- , bgroup "length"- [ bgroup "cons"- [ benchT $ nf (T.length . T.cons c) ta- , benchTL $ nf (TL.length . TL.cons c) tla- , benchBS $ nf (BS.length . BS.cons c) bsa- , benchBSL $ nf (BL.length . BL.cons c) bla- , benchS $ nf (L.length . (:) c) sa- ]- , bgroup "decode"- [ benchT $ nf (T.length . T.decodeUtf8) bsa- , benchTL $ nf (TL.length . TL.decodeUtf8) bla- , benchBS $ nf (L.length . BS.unpack) bsa- , benchBSL $ nf (L.length . BL.unpack) bla- , bench "StringUTF8" $ nf (L.length . UTF8.toString) bsa- ]- , bgroup "drop"- [ benchT $ nf (T.length . T.drop (ta_len `div` 3)) ta- , benchTL $ nf (TL.length . TL.drop (tla_len `div` 3)) tla- , benchBS $ nf (BS.length . BS.drop (bsa_len `div` 3)) bsa- , benchBSL $ nf (BL.length . BL.drop (bla_len `div` 3)) bla- , benchS $ nf (L.length . L.drop (sa_len `div` 3)) sa- ]- , bgroup "filter"- [ benchT $ nf (T.length . T.filter p0) ta- , benchTL $ nf (TL.length . TL.filter p0) tla- , benchBS $ nf (BS.length . BS.filter p0) bsa- , benchBSL $ nf (BL.length . BL.filter p0) bla- , benchS $ nf (L.length . L.filter p0) sa- ]- , bgroup "filter.filter"- [ benchT $ nf (T.length . T.filter p1 . T.filter p0) ta- , benchTL $ nf (TL.length . TL.filter p1 . TL.filter p0) tla- , benchBS $ nf (BS.length . BS.filter p1 . BS.filter p0) bsa- , benchBSL $ nf (BL.length . BL.filter p1 . BL.filter p0) bla- , benchS $ nf (L.length . L.filter p1 . L.filter p0) sa- ]- , bgroup "init"- [ benchT $ nf (T.length . T.init) ta- , benchTL $ nf (TL.length . TL.init) tla- , benchBS $ nf (BS.length . BS.init) bsa- , benchBSL $ nf (BL.length . BL.init) bla- , benchS $ nf (L.length . L.init) sa- ]- , bgroup "intercalate"- [ benchT $ nf (T.length . T.intercalate tsw) tl- , benchTL $ nf (TL.length . TL.intercalate tlw) tll- , benchBS $ nf (BS.length . BS.intercalate bsw) bsl- , benchBSL $ nf (BL.length . BL.intercalate blw) bll- , benchS $ nf (L.length . L.intercalate lw) sl- ]- , bgroup "intersperse"- [ benchT $ nf (T.length . T.intersperse c) ta- , benchTL $ nf (TL.length . TL.intersperse c) tla- , benchBS $ nf (BS.length . BS.intersperse c) bsa- , benchBSL $ nf (BL.length . BL.intersperse c) bla- , benchS $ nf (L.length . L.intersperse c) sa- ]- , bgroup "map"- [ benchT $ nf (T.length . T.map f) ta- , benchTL $ nf (TL.length . TL.map f) tla- , benchBS $ nf (BS.length . BS.map f) bsa- , benchBSL $ nf (BL.length . BL.map f) bla- , benchS $ nf (L.length . L.map f) sa- ]- , bgroup "map.map"- [ benchT $ nf (T.length . T.map f . T.map f) ta- , benchTL $ nf (TL.length . TL.map f . TL.map f) tla- , benchBS $ nf (BS.length . BS.map f . BS.map f) bsa- , benchS $ nf (L.length . L.map f . L.map f) sa- ]- , bgroup "replicate char"- [ benchT $ nf (T.length . T.replicate bsa_len) (T.singleton c)- , benchTL $ nf (TL.length . TL.replicate (fromIntegral bsa_len)) (TL.singleton c)- , benchBS $ nf (BS.length . BS.replicate bsa_len) c- , benchBSL $ nf (BL.length . BL.replicate (fromIntegral bsa_len)) c- , benchS $ nf (L.length . L.replicate bsa_len) c- ]- , bgroup "replicate string"- [ benchT $ nf (T.length . T.replicate (bsa_len `div` T.length tsw)) tsw- , benchTL $ nf (TL.length . TL.replicate (fromIntegral bsa_len `div` TL.length tlw)) tlw- , benchS $ nf (L.length . replicat (bsa_len `div` T.length tsw)) lw- ]- , bgroup "take"- [ benchT $ nf (T.length . T.take (ta_len `div` 3)) ta- , benchTL $ nf (TL.length . TL.take (tla_len `div` 3)) tla- , benchBS $ nf (BS.length . BS.take (bsa_len `div` 3)) bsa- , benchBSL $ nf (BL.length . BL.take (bla_len `div` 3)) bla- , benchS $ nf (L.length . L.take (sa_len `div` 3)) sa- ]- , bgroup "tail"- [ benchT $ nf (T.length . T.tail) ta- , benchTL $ nf (TL.length . TL.tail) tla- , benchBS $ nf (BS.length . BS.tail) bsa- , benchBSL $ nf (BL.length . BL.tail) bla- , benchS $ nf (L.length . L.tail) sa- ]- , bgroup "toLower"- [ benchT $ nf (T.length . T.toLower) ta- , benchTL $ nf (TL.length . TL.toLower) tla- , benchBS $ nf (BS.length . BS.map toLower) bsa- , benchBSL $ nf (BL.length . BL.map toLower) bla- , benchS $ nf (L.length . L.map toLower) sa- ]- , bgroup "toUpper"- [ benchT $ nf (T.length . T.toUpper) ta- , benchTL $ nf (TL.length . TL.toUpper) tla- , benchBS $ nf (BS.length . BS.map toUpper) bsa- , benchBSL $ nf (BL.length . BL.map toUpper) bla- , benchS $ nf (L.length . L.map toUpper) sa- ]- , bgroup "words"- [ benchT $ nf (L.length . T.words) ta- , benchTL $ nf (L.length . TL.words) tla- , benchBS $ nf (L.length . BS.words) bsa- , benchBSL $ nf (L.length . BL.words) bla- , benchS $ nf (L.length . L.words) sa- ]- , bgroup "zipWith"- [ benchT $ nf (T.length . T.zipWith min tb) ta- , benchTL $ nf (TL.length . TL.zipWith min tlb) tla- , benchBS $ nf (L.length . BS.zipWith min bsb) bsa- , benchBSL $ nf (L.length . BL.zipWith min blb) bla- , benchS $ nf (L.length . L.zipWith min sb) sa- ]- ]- , bgroup "Builder"- [ bench "mappend char" $ nf (TL.length . TB.toLazyText . mappendNChar 'a') 10000- , bench "mappend 8 char" $ nf (TL.length . TB.toLazyText . mappend8Char) 'a'- , bench "mappend text" $ nf (TL.length . TB.toLazyText . mappendNText short) 10000- ]- ]- where- benchS = bench "String"- benchT = bench "Text"- benchTL = bench "LazyText"- benchBS = bench "ByteString"- benchBSL = bench "LazyByteString"-- c = 'й'- p0 = (== c)- p1 = (/= 'д')- lw = "право"- bsw = UTF8.fromString lw- blw = BL.fromChunks [bsw]- tsw = T.pack lw- tlw = TL.fromChunks [tsw]- f (C# c#) = C# (chr# (ord# c# +# 1#))- g (I# i#) (C# c#) = (I# (i# +# 1#), C# (chr# (ord# c# +# i#)))- len l _ = l + (1::Int)- replicat n = concat . L.replicate n- short = T.pack "short"--instance NFData BS.ByteString--instance NFData BL.ByteString where- rnf BL.Empty = ()- rnf (BL.Chunk _ ts) = rnf ts--data B where- B :: NFData a => a -> B--instance NFData B where- rnf (B b) = rnf b---- | Split a bytestring in chunks----chunksOf :: Int -> BS.ByteString -> [BS.ByteString]-chunksOf k = go- where- go t = case BS.splitAt k t of- (a,b) | BS.null a -> []- | otherwise -> a : go b---- | Append a character n times----mappendNChar :: Char -> Int -> TB.Builder-mappendNChar c n = go 0- where- go i- | i < n = TB.singleton c `mappend` go (i+1)- | otherwise = mempty---- | Gives more opportunity for inlining and elimination of unnecesary--- bounds checks.----mappend8Char :: Char -> TB.Builder-mappend8Char c = TB.singleton c `mappend` TB.singleton c `mappend`- TB.singleton c `mappend` TB.singleton c `mappend`- TB.singleton c `mappend` TB.singleton c `mappend`- TB.singleton c `mappend` TB.singleton c---- | Append a text N times----mappendNText :: T.Text -> Int -> TB.Builder-mappendNText t n = go 0- where- go i- | i < n = TB.fromText t `mappend` go (i+1)- | otherwise = mempty
− tests/benchmarks/src/Data/Text/Benchmarks/ReadNumbers.hs
@@ -1,96 +0,0 @@--- | Read numbers from a file with a just a number on each line, find the--- minimum of those numbers. The file contains different kinds of numbers:------ * Decimals------ * Hexadecimals------ * Floating point numbers------ * Floating point numbers in scientific notation------ The different benchmarks will only take into account the values they can--- parse.------ Tested in this benchmark:------ * Lexing/parsing of different numerical types----module Data.Text.Benchmarks.ReadNumbers- ( benchmark- ) where--import Criterion (Benchmark, bgroup, bench, whnf)-import Data.List (foldl')-import Numeric (readDec, readFloat, readHex)-import qualified Data.ByteString.Char8 as B-import qualified Data.ByteString.Lazy.Char8 as BL-import qualified Data.ByteString.Lex.Double as B-import qualified Data.ByteString.Lex.Lazy.Double as BL-import qualified Data.Text as T-import qualified Data.Text.IO as T-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.IO as TL-import qualified Data.Text.Lazy.Read as TL-import qualified Data.Text.Read as T--benchmark :: FilePath -> IO Benchmark-benchmark fp = do- -- Read all files into lines: string, text, lazy text, bytestring, lazy- -- bytestring- s <- lines `fmap` readFile fp- t <- T.lines `fmap` T.readFile fp- tl <- TL.lines `fmap` TL.readFile fp- b <- B.lines `fmap` B.readFile fp- bl <- BL.lines `fmap` BL.readFile fp- return $ bgroup "ReadNumbers"- [ bench "DecimalString" $ whnf (int . string readDec) s- , bench "HexadecimalString" $ whnf (int . string readHex) s- , bench "DoubleString" $ whnf (double . string readFloat) s-- , bench "DecimalText" $ whnf (int . text (T.signed T.decimal)) t- , bench "HexadecimalText" $ whnf (int . text (T.signed T.hexadecimal)) t- , bench "DoubleText" $ whnf (double . text T.double) t- , bench "RationalText" $ whnf (double . text T.rational) t-- , bench "DecimalLazyText" $- whnf (int . text (TL.signed TL.decimal)) tl- , bench "HexadecimalLazyText" $- whnf (int . text (TL.signed TL.hexadecimal)) tl- , bench "DoubleLazyText" $- whnf (double . text TL.double) tl- , bench "RationalLazyText" $- whnf (double . text TL.rational) tl-- , bench "DecimalByteString" $ whnf (int . byteString B.readInt) b- , bench "DoubleByteString" $ whnf (double . byteString B.readDouble) b-- , bench "DecimalLazyByteString" $- whnf (int . byteString BL.readInt) bl- , bench "DoubleLazyByteString" $- whnf (double . byteString BL.readDouble) bl- ]- where- -- Used for fixing types- int :: Int -> Int- int = id- double :: Double -> Double- double = id--string :: (Ord a, Num a) => (t -> [(a, t)]) -> [t] -> a-string reader = foldl' go 1000000- where- go z t = case reader t of [(n, _)] -> min n z- _ -> z--text :: (Ord a, Num a) => (t -> Either String (a,t)) -> [t] -> a-text reader = foldl' go 1000000- where- go z t = case reader t of Left _ -> z- Right (n, _) -> min n z- -byteString :: (Ord a, Num a) => (t -> Maybe (a,t)) -> [t] -> a-byteString reader = foldl' go 1000000- where- go z t = case reader t of Nothing -> z- Just (n, _) -> min n z
− tests/benchmarks/src/Data/Text/Benchmarks/Replace.hs
@@ -1,31 +0,0 @@--- | Replace a string by another string------ Tested in this benchmark:------ * Search and replace of a pattern in a text----module Data.Text.Benchmarks.Replace- ( benchmark- ) where--import Criterion (Benchmark, bgroup, bench, nf)-import qualified Data.ByteString.Char8 as B-import qualified Data.ByteString.Lazy as BL-import qualified Data.ByteString.Lazy.Search as BL-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Encoding as TL-import qualified Data.Text.Lazy.IO as TL--benchmark :: FilePath -> String -> String -> IO Benchmark-benchmark fp pat sub = do- tl <- TL.readFile fp- bl <- BL.readFile fp- return $ bgroup "Replace"- [ bench "LazyText" $ nf (TL.length . TL.replace tpat tsub) tl- , bench "LazyByteString" $ nf (BL.length . BL.replace bpat bsub) bl- ]- where- tpat = TL.pack pat- tsub = TL.pack sub- bpat = B.concat $ BL.toChunks $ TL.encodeUtf8 tpat- bsub = B.concat $ BL.toChunks $ TL.encodeUtf8 tsub
− tests/benchmarks/src/Data/Text/Benchmarks/Search.hs
@@ -1,48 +0,0 @@--- | Search for a pattern in a file, find the number of occurences------ Tested in this benchmark:------ * Searching all occurences of a pattern using library routines----module Data.Text.Benchmarks.Search- ( benchmark- ) where--import Criterion (Benchmark, bench, bgroup, whnf)-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL-import qualified Data.ByteString.Lazy.Search as BL-import qualified Data.ByteString.Search as B-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import qualified Data.Text.IO as T-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.IO as TL--benchmark :: FilePath -> T.Text -> IO Benchmark-benchmark fp needleT = do- b <- B.readFile fp- bl <- BL.readFile fp- t <- T.readFile fp- tl <- TL.readFile fp- return $ bgroup "FileIndices"- [ bench "ByteString" $ whnf (byteString needleB) b- , bench "LazyByteString" $ whnf (lazyByteString needleB) bl- , bench "Text" $ whnf (text needleT) t- , bench "LazyText" $ whnf (lazyText needleTL) tl- ]- where- needleB = T.encodeUtf8 needleT- needleTL = TL.fromChunks [needleT]--byteString :: B.ByteString -> B.ByteString -> Int-byteString needle = length . B.indices needle--lazyByteString :: B.ByteString -> BL.ByteString -> Int-lazyByteString needle = length . BL.indices needle--text :: T.Text -> T.Text -> Int-text = T.count--lazyText :: TL.Text -> TL.Text -> Int-lazyText needle = fromIntegral . TL.count needle
− tests/benchmarks/src/Data/Text/Benchmarks/Stream.hs
@@ -1,94 +0,0 @@--- | This module contains a number of benchmarks for the different streaming--- functions------ Tested in this benchmark:------ * Most streaming functions----{-# LANGUAGE BangPatterns #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-module Data.Text.Benchmarks.Stream- ( benchmark- ) where--import Control.DeepSeq (NFData (..))-import Criterion (Benchmark, bgroup, bench, nf)-import Data.Text.Fusion.Internal (Step (..), Stream (..))-import qualified Data.Text.Encoding as T-import qualified Data.Text.Encoding.Error as E-import qualified Data.Text.Encoding.Fusion as T-import qualified Data.Text.Encoding.Fusion.Common as F-import qualified Data.Text.Fusion as T-import qualified Data.Text.IO as T-import qualified Data.Text.Lazy.Encoding as TL-import qualified Data.Text.Lazy.Encoding.Fusion as TL-import qualified Data.Text.Lazy.Fusion as TL-import qualified Data.Text.Lazy.IO as TL--instance NFData a => NFData (Stream a) where- -- Currently, this implementation does not force evaluation of the size hint- rnf (Stream next s0 _) = go s0- where- go !s = case next s of- Done -> ()- Skip s' -> go s'- Yield x s' -> rnf x `seq` go s'--benchmark :: FilePath -> IO Benchmark-benchmark fp = do- -- Different formats- t <- T.readFile fp- let !utf8 = T.encodeUtf8 t- !utf16le = T.encodeUtf16LE t- !utf16be = T.encodeUtf16BE t- !utf32le = T.encodeUtf32LE t- !utf32be = T.encodeUtf32BE t-- -- Once again for the lazy variants- tl <- TL.readFile fp- let !utf8L = TL.encodeUtf8 tl- !utf16leL = TL.encodeUtf16LE tl- !utf16beL = TL.encodeUtf16BE tl- !utf32leL = TL.encodeUtf32LE tl- !utf32beL = TL.encodeUtf32BE tl-- -- For the functions which operate on streams- let !s = T.stream t-- return $ bgroup "Stream"-- -- Fusion- [ bgroup "stream" $- [ bench "Text" $ nf T.stream t- , bench "LazyText" $ nf TL.stream tl- ]-- -- Encoding.Fusion- , bgroup "streamUtf8"- [ bench "Text" $ nf (T.streamUtf8 E.lenientDecode) utf8- , bench "LazyText" $ nf (TL.streamUtf8 E.lenientDecode) utf8L- ]- , bgroup "streamUtf16LE"- [ bench "Text" $ nf (T.streamUtf16LE E.lenientDecode) utf16le- , bench "LazyText" $ nf (TL.streamUtf16LE E.lenientDecode) utf16leL- ]- , bgroup "streamUtf16BE"- [ bench "Text" $ nf (T.streamUtf16BE E.lenientDecode) utf16be- , bench "LazyText" $ nf (TL.streamUtf16BE E.lenientDecode) utf16beL- ]- , bgroup "streamUtf32LE"- [ bench "Text" $ nf (T.streamUtf32LE E.lenientDecode) utf32le- , bench "LazyText" $ nf (TL.streamUtf32LE E.lenientDecode) utf32leL- ]- , bgroup "streamUtf32BE"- [ bench "Text" $ nf (T.streamUtf32BE E.lenientDecode) utf32be- , bench "LazyText" $ nf (TL.streamUtf32BE E.lenientDecode) utf32beL- ]-- -- Encoding.Fusion.Common- , bench "restreamUtf8" $ nf F.restreamUtf8 s- , bench "restreamUtf16LE" $ nf F.restreamUtf16LE s- , bench "restreamUtf16BE" $ nf F.restreamUtf16BE s- , bench "restreamUtf32LE" $ nf F.restreamUtf32LE s- , bench "restreamUtf32BE" $ nf F.restreamUtf32BE s- ]
− tests/benchmarks/src/Data/Text/Benchmarks/WordFrequencies.hs
@@ -1,36 +0,0 @@--- | A word frequency count using the different string types------ Tested in this benchmark:------ * Splitting into words------ * Converting to lowercase------ * Comparing: Eq/Ord instances----module Data.Text.Benchmarks.WordFrequencies- ( benchmark- ) where--import Criterion (Benchmark, bench, bgroup, whnf)-import Data.Char (toLower)-import Data.List (foldl')-import Data.Map (Map)-import qualified Data.ByteString.Char8 as B-import qualified Data.Map as M-import qualified Data.Text as T-import qualified Data.Text.IO as T--benchmark :: FilePath -> IO Benchmark-benchmark fp = do- s <- readFile fp- b <- B.readFile fp- t <- T.readFile fp- return $ bgroup "WordFrequencies"- [ bench "String" $ whnf (frequencies . words . map toLower) s- , bench "ByteString" $ whnf (frequencies . B.words . B.map toLower) b- , bench "Text" $ whnf (frequencies . T.words . T.toLower) t- ]--frequencies :: Ord a => [a] -> Map a Int-frequencies = foldl' (\m k -> M.insertWith (+) k 1 m) M.empty
− tests/benchmarks/text-benchmarks.cabal
@@ -1,36 +0,0 @@-name: text-benchmarks-version: 0.0.0.0-synopsis: Benchmarks for the text package-description: Benchmarks for the text package-homepage: https://bitbucket.org/bos/text-license: BSD3-license-file: ../../LICENSE-author: Jasper Van der Jeugt <jaspervdj@gmail.com>,- Bryan O'Sullivan <bos@serpentine.com>,- Tom Harper <rtomharper@googlemail.com>,- Duncan Coutts <duncan@haskell.org>-maintainer: jaspervdj@gmail.com-category: Text-build-type: Simple--cabal-version: >=1.2--executable text-benchmarks- hs-source-dirs: src ../..- c-sources: ../../cbits/cbits.c- cbits/time_iconv.c- main-is: Data/Text/Benchmarks.hs- ghc-options: -Wall -O2- cpp-options: -DHAVE_DEEPSEQ- build-depends: base >= 4 && < 5,- criterion >= 0.5 && < 0.7,- bytestring >= 0.9,- deepseq >= 1.1 && < 1.2,- filepath >= 1.1 && < 1.3,- directory >= 1.1 && < 1.2,- containers >= 0.3 && < 0.5,- binary >= 0.5 && < 0.6,- utf8-string >= 0.3 && < 0.4,- blaze-builder >= 0.3 && < 0.4,- bytestring-lexing >= 0.2 && < 0.3,- stringsearch >= 0.3 && < 0.4
+ tests/scripts/cover-stdio.sh view
@@ -0,0 +1,62 @@+#!/bin/bash++if [[ $# < 1 ]]; then+ echo "Usage: $0 <exe>"+ exit 1+fi++exe=$1++rm -f $exe.tix++f=$(mktemp stdio-f.XXXXXX)+g=$(mktemp stdio-g.XXXXXX)++for t in T TL; do+ echo $t.readFile > $f+ $exe $t.readFile $f > $g+ if ! diff -u $f $g; then+ errs=$((errs+1))+ echo FAIL: $t.readFile 1>&2+ fi++ $exe $t.writeFile $f $t.writeFile+ echo -n $t.writeFile > $g+ if ! diff -u $f $g; then+ errs=$((errs+1))+ echo FAIL: $t.writeFile 1>&2+ fi++ echo -n quux > $f+ $exe $t.appendFile $f $t.appendFile+ echo -n quux$t.appendFile > $g+ if ! diff -u $f $g; then+ errs=$((errs+1))+ echo FAIL: $t.appendFile 1>&2+ fi++ echo $t.interact | $exe $t.interact > $f+ echo $t.interact > $g+ if ! diff -u $f $g; then+ errs=$((errs+1))+ echo FAIL: $t.interact 1>&2+ fi++ echo $t.getContents | $exe $t.getContents > $f+ echo $t.getContents > $g+ if ! diff -u $f $g; then+ errs=$((errs+1))+ echo FAIL: $t.getContents 1>&2+ fi++ echo $t.getLine | $exe $t.getLine > $f+ echo $t.getLine > $g+ if ! diff -u $f $g; then+ errs=$((errs+1))+ echo FAIL: $t.getLine 1>&2+ fi+done++rm -f $f $g++exit $errs
− tests/tests/.ghci
@@ -1,1 +0,0 @@-:set -DHAVE_DEEPSEQ -isrc -i../..
− tests/tests/Makefile
@@ -1,29 +0,0 @@-coverage: build coverage/hpc_index.html--build:- cabal configure -fhpc- cabal build--coverage/text-tests.tix:- -mkdir -p coverage- ./dist/build/text-tests/text-tests- mv text-tests.tix $@--coverage/text-tests-stdio.tix:- -mkdir -p coverage- ./scripts/cover-stdio.sh ./dist/build/text-tests-stdio/text-tests-stdio- mv text-tests-stdio.tix $@--coverage/coverage.tix: coverage/text-tests.tix coverage/text-tests-stdio.tix- hpc combine --output=$@ \- --exclude=Main \- coverage/text-tests.tix \- coverage/text-tests-stdio.tix--coverage/hpc_index.html: coverage/coverage.tix- hpc markup --destdir=coverage coverage/coverage.tix--clean:- rm -rf dist coverage .hpc--.PHONY: build coverage
− tests/tests/scripts/cover-stdio.sh
@@ -1,62 +0,0 @@-#!/bin/bash--if [[ $# < 1 ]]; then- echo "Usage: $0 <exe>"- exit 1-fi--exe=$1--rm -f $exe.tix--f=$(mktemp stdio-f.XXXXXX)-g=$(mktemp stdio-g.XXXXXX)--for t in T TL; do- echo $t.readFile > $f- $exe $t.readFile $f > $g- if ! diff -u $f $g; then- errs=$((errs+1))- echo FAIL: $t.readFile 1>&2- fi-- $exe $t.writeFile $f $t.writeFile- echo -n $t.writeFile > $g- if ! diff -u $f $g; then- errs=$((errs+1))- echo FAIL: $t.writeFile 1>&2- fi-- echo -n quux > $f- $exe $t.appendFile $f $t.appendFile- echo -n quux$t.appendFile > $g- if ! diff -u $f $g; then- errs=$((errs+1))- echo FAIL: $t.appendFile 1>&2- fi-- echo $t.interact | $exe $t.interact > $f- echo $t.interact > $g- if ! diff -u $f $g; then- errs=$((errs+1))- echo FAIL: $t.interact 1>&2- fi-- echo $t.getContents | $exe $t.getContents > $f- echo $t.getContents > $g- if ! diff -u $f $g; then- errs=$((errs+1))- echo FAIL: $t.getContents 1>&2- fi-- echo $t.getLine | $exe $t.getLine > $f- echo $t.getLine > $g- if ! diff -u $f $g; then- errs=$((errs+1))- echo FAIL: $t.getLine 1>&2- fi-done--rm -f $f $g--exit $errs
− tests/tests/src/Data/Text/Tests.hs
@@ -1,13 +0,0 @@--- | Provides a simple main function which runs all the tests----module Main- ( main- ) where--import Test.Framework (defaultMain)--import qualified Data.Text.Tests.Properties as Properties-import qualified Data.Text.Tests.Regressions as Regressions--main :: IO ()-main = defaultMain [Properties.tests, Regressions.tests]
− tests/tests/src/Data/Text/Tests/IO.hs
@@ -1,34 +0,0 @@--- | Program which exposes some haskell functions as an exutable. The results--- and coverage of this module is meant to be checked using a shell script.----module Main- (- main- ) where--import System.Environment (getArgs)-import System.Exit (exitFailure)-import System.IO (hPutStrLn, stderr)-import qualified Data.Text as T-import qualified Data.Text.IO as T-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.IO as TL--main :: IO ()-main = do- args <- getArgs- case args of- ["T.readFile", name] -> T.putStr =<< T.readFile name- ["T.writeFile", name, t] -> T.writeFile name (T.pack t)- ["T.appendFile", name, t] -> T.appendFile name (T.pack t)- ["T.interact"] -> T.interact id- ["T.getContents"] -> T.putStr =<< T.getContents- ["T.getLine"] -> T.putStrLn =<< T.getLine-- ["TL.readFile", name] -> TL.putStr =<< TL.readFile name- ["TL.writeFile", name, t] -> TL.writeFile name (TL.pack t)- ["TL.appendFile", name, t] -> TL.appendFile name (TL.pack t)- ["TL.interact"] -> TL.interact id- ["TL.getContents"] -> TL.putStr =<< TL.getContents- ["TL.getLine"] -> TL.putStrLn =<< TL.getLine- _ -> hPutStrLn stderr "invalid directive!" >> exitFailure
− tests/tests/src/Data/Text/Tests/Properties.hs
@@ -1,1118 +0,0 @@--- | General quicktest properties for the text library----{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,- ScopedTypeVariables, TypeSynonymInstances, CPP #-}-{-# OPTIONS_GHC -fno-enable-rewrite-rules #-}-{-# OPTIONS_GHC -fno-warn-missing-signatures #-}-module Data.Text.Tests.Properties- (- tests- ) where--import Test.QuickCheck-import Test.QuickCheck.Monadic-import Text.Show.Functions ()--import Control.Arrow ((***), second)-import Control.Exception (catch)-import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)-import Data.Monoid (Monoid(..))-import Data.String (fromString)-import Data.Text.Encoding.Error-import Data.Text.Foreign-import Data.Text.Fusion.Size-import Data.Text.Lazy.Read as TL-import Data.Text.Read as T-import Data.Text.Search (indices)-import Data.Word (Word8, Word16, Word32)-import Numeric (showHex)-import Prelude hiding (catch, replicate)-import Test.Framework (Test, testGroup)-import Test.Framework.Providers.QuickCheck2 (testProperty)-import qualified Data.Bits as Bits (shiftL, shiftR)-import qualified Data.ByteString as B-import qualified Data.List as L-import qualified Data.Text as T-import qualified Data.Text.Encoding as E-import qualified Data.Text.Fusion as S-import qualified Data.Text.Fusion.Common as S-import qualified Data.Text.IO as T-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Builder as TB-import qualified Data.Text.Lazy.Encoding as EL-import qualified Data.Text.Lazy.Fusion as SL-import qualified Data.Text.Lazy.IO as TL-import qualified Data.Text.Lazy.Search as S (indices)-import qualified Data.Text.UnsafeShift as U-import qualified System.IO as IO--import Data.Text.Tests.QuickCheckUtils-import Data.Text.Tests.Utils-import qualified Data.Text.Tests.SlowFunctions as Slow--t_pack_unpack = (T.unpack . T.pack) `eq` id-tl_pack_unpack = (TL.unpack . TL.pack) `eq` id-t_stream_unstream = (S.unstream . S.stream) `eq` id-tl_stream_unstream = (SL.unstream . SL.stream) `eq` id-t_reverse_stream t = (S.reverse . S.reverseStream) t == t-t_singleton c = [c] == (T.unpack . T.singleton) c-tl_singleton c = [c] == (TL.unpack . TL.singleton) c-tl_unstreamChunks x = f 11 x == f 1000 x- where f n = SL.unstreamChunks n . S.streamList-tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id-tl_from_to_strict = (TL.fromStrict . TL.toStrict) `eq` id--t_ascii t = E.decodeASCII (E.encodeUtf8 a) == a- where a = T.map (\c -> chr (ord c `mod` 128)) t-tl_ascii t = EL.decodeASCII (EL.encodeUtf8 a) == a- where a = TL.map (\c -> chr (ord c `mod` 128)) t-t_utf8 = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id-t_utf8' = forAll genUnicode $ (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right)-tl_utf8 = forAll genUnicode $ (EL.decodeUtf8 . EL.encodeUtf8) `eq` id-tl_utf8' = forAll genUnicode $ (EL.decodeUtf8' . EL.encodeUtf8) `eq` (id . Right)-t_utf16LE = forAll genUnicode $ (E.decodeUtf16LE . E.encodeUtf16LE) `eq` id-tl_utf16LE = forAll genUnicode $ (EL.decodeUtf16LE . EL.encodeUtf16LE) `eq` id-t_utf16BE = forAll genUnicode $ (E.decodeUtf16BE . E.encodeUtf16BE) `eq` id-tl_utf16BE = forAll genUnicode $ (EL.decodeUtf16BE . EL.encodeUtf16BE) `eq` id-t_utf32LE = forAll genUnicode $ (E.decodeUtf32LE . E.encodeUtf32LE) `eq` id-tl_utf32LE = forAll genUnicode $ (EL.decodeUtf32LE . EL.encodeUtf32LE) `eq` id-t_utf32BE = forAll genUnicode $ (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id-tl_utf32BE = forAll genUnicode $ (EL.decodeUtf32BE . EL.encodeUtf32BE) `eq` id---- This is a poor attempt to ensure that the error handling paths on--- decode are exercised in some way. Proper testing would be rather--- more involved.-t_utf8_err :: DecodeErr -> B.ByteString -> Property-t_utf8_err (DE _ de) bs = monadicIO $ do- l <- run $ let len = T.length (E.decodeUtf8With de bs)- in (len `seq` return (Right len)) `catch`- (\(e::UnicodeException) -> return (Left e))- case l of- Left err -> assert $ length (show err) >= 0- Right n -> assert $ n >= 0--t_utf8_err' :: B.ByteString -> Property-t_utf8_err' bs = monadicIO . assert $ case E.decodeUtf8' bs of- Left err -> length (show err) >= 0- Right t -> T.length t >= 0--s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)- where _types = s :: String-sf_Eq p s =- ((L.filter p s==) . L.filter p) `eq`- (((S.filter p $ S.streamList s)==) . S.filter p . S.streamList)-t_Eq s = (s==) `eq` ((T.pack s==) . T.pack)-tl_Eq s = (s==) `eq` ((TL.pack s==) . TL.pack)-s_Ord s = (compare s) `eq` (compare (S.streamList s) . S.streamList)- where _types = s :: String-sf_Ord p s =- ((compare $ L.filter p s) . L.filter p) `eq`- (compare (S.filter p $ S.streamList s) . S.filter p . S.streamList)-t_Ord s = (compare s) `eq` (compare (T.pack s) . T.pack)-tl_Ord s = (compare s) `eq` (compare (TL.pack s) . TL.pack)-t_Read = id `eq` (T.unpack . read . show)-tl_Read = id `eq` (TL.unpack . read . show)-t_Show = show `eq` (show . T.pack)-tl_Show = show `eq` (show . TL.pack)-t_mappend s = mappend s`eqP` (unpackS . mappend (T.pack s))-tl_mappend s = mappend s`eqP` (unpackS . mappend (TL.pack s))-t_mconcat = mconcat `eq` (unpackS . mconcat . L.map T.pack)-tl_mconcat = mconcat `eq` (unpackS . mconcat . L.map TL.pack)-t_mempty = mempty == (unpackS (mempty :: T.Text))-tl_mempty = mempty == (unpackS (mempty :: TL.Text))-t_IsString = fromString `eqP` (T.unpack . fromString)-tl_IsString = fromString `eqP` (TL.unpack . fromString)--s_cons x = (x:) `eqP` (unpackS . S.cons x)-s_cons_s x = (x:) `eqP` (unpackS . S.unstream . S.cons x)-sf_cons p x = ((x:) . L.filter p) `eqP` (unpackS . S.cons x . S.filter p)-t_cons x = (x:) `eqP` (unpackS . T.cons x)-tl_cons x = (x:) `eqP` (unpackS . TL.cons x)-s_snoc x = (++ [x]) `eqP` (unpackS . (flip S.snoc) x)-t_snoc x = (++ [x]) `eqP` (unpackS . (flip T.snoc) x)-tl_snoc x = (++ [x]) `eqP` (unpackS . (flip TL.snoc) x)-s_append s = (s++) `eqP` (unpackS . S.append (S.streamList s))-s_append_s s = (s++) `eqP`- (unpackS . S.unstream . S.append (S.streamList s))-sf_append p s = (L.filter p s++) `eqP`- (unpackS . S.append (S.filter p $ S.streamList s))-t_append s = (s++) `eqP` (unpackS . T.append (packS s))--uncons (x:xs) = Just (x,xs)-uncons _ = Nothing--s_uncons = uncons `eqP` (fmap (second unpackS) . S.uncons)-sf_uncons p = (uncons . L.filter p) `eqP`- (fmap (second unpackS) . S.uncons . S.filter p)-t_uncons = uncons `eqP` (fmap (second unpackS) . T.uncons)-tl_uncons = uncons `eqP` (fmap (second unpackS) . TL.uncons)-s_head = head `eqP` S.head-sf_head p = (head . L.filter p) `eqP` (S.head . S.filter p)-t_head = head `eqP` T.head-tl_head = head `eqP` TL.head-s_last = last `eqP` S.last-sf_last p = (last . L.filter p) `eqP` (S.last . S.filter p)-t_last = last `eqP` T.last-tl_last = last `eqP` TL.last-s_tail = tail `eqP` (unpackS . S.tail)-s_tail_s = tail `eqP` (unpackS . S.unstream . S.tail)-sf_tail p = (tail . L.filter p) `eqP` (unpackS . S.tail . S.filter p)-t_tail = tail `eqP` (unpackS . T.tail)-tl_tail = tail `eqP` (unpackS . TL.tail)-s_init = init `eqP` (unpackS . S.init)-s_init_s = init `eqP` (unpackS . S.unstream . S.init)-sf_init p = (init . L.filter p) `eqP` (unpackS . S.init . S.filter p)-t_init = init `eqP` (unpackS . T.init)-tl_init = init `eqP` (unpackS . TL.init)-s_null = null `eqP` S.null-sf_null p = (null . L.filter p) `eqP` (S.null . S.filter p)-t_null = null `eqP` T.null-tl_null = null `eqP` TL.null-s_length = length `eqP` S.length-sf_length p = (length . L.filter p) `eqP` (S.length . S.filter p)-sl_length = (fromIntegral . length) `eqP` SL.length-t_length = length `eqP` T.length-tl_length = L.genericLength `eqP` TL.length-t_compareLength t = (compare (T.length t)) `eq` T.compareLength t-tl_compareLength t= (compare (TL.length t)) `eq` TL.compareLength t--s_map f = map f `eqP` (unpackS . S.map f)-s_map_s f = map f `eqP` (unpackS . S.unstream . S.map f)-sf_map p f = (map f . L.filter p) `eqP` (unpackS . S.map f . S.filter p)-t_map f = map f `eqP` (unpackS . T.map f)-tl_map f = map f `eqP` (unpackS . TL.map f)-s_intercalate c = L.intercalate c `eq`- (unpackS . S.intercalate (packS c) . map packS)-t_intercalate c = L.intercalate c `eq`- (unpackS . T.intercalate (packS c) . map packS)-tl_intercalate c = L.intercalate c `eq`- (unpackS . TL.intercalate (TL.pack c) . map TL.pack)-s_intersperse c = L.intersperse c `eqP`- (unpackS . S.intersperse c)-s_intersperse_s c = L.intersperse c `eqP`- (unpackS . S.unstream . S.intersperse c)-sf_intersperse p c= (L.intersperse c . L.filter p) `eqP`- (unpackS . S.intersperse c . S.filter p)-t_intersperse c = L.intersperse c `eqP` (unpackS . T.intersperse c)-tl_intersperse c = L.intersperse c `eqP` (unpackS . TL.intersperse c)-t_transpose = L.transpose `eq` (map unpackS . T.transpose . map packS)-tl_transpose = L.transpose `eq` (map unpackS . TL.transpose . map TL.pack)-t_reverse = L.reverse `eqP` (unpackS . T.reverse)-tl_reverse = L.reverse `eqP` (unpackS . TL.reverse)-t_reverse_short n = L.reverse `eqP` (unpackS . S.reverse . shorten n . S.stream)--t_replace s d = (L.intercalate d . splitOn s) `eqP`- (unpackS . T.replace (T.pack s) (T.pack d))-tl_replace s d = (L.intercalate d . splitOn s) `eqP`- (unpackS . TL.replace (TL.pack s) (TL.pack d))--splitOn :: (Eq a) => [a] -> [a] -> [[a]]-splitOn pat src0- | l == 0 = error "empty"- | otherwise = go src0- where- l = length pat- go src = search 0 src- where- search _ [] = [src]- search !n s@(_:s')- | pat `L.isPrefixOf` s = take n src : go (drop l s)- | otherwise = search (n+1) s'--s_toCaseFold_length xs = S.length (S.toCaseFold s) >= length xs- where s = S.streamList xs-sf_toCaseFold_length p xs =- (S.length . S.toCaseFold . S.filter p $ s) >= (length . L.filter p $ xs)- where s = S.streamList xs-t_toCaseFold_length t = T.length (T.toCaseFold t) >= T.length t-tl_toCaseFold_length t = TL.length (TL.toCaseFold t) >= TL.length t-t_toLower_length t = T.length (T.toLower t) >= T.length t-t_toLower_lower t = p (T.toLower t) >= p t- where p = T.length . T.filter isLower-tl_toLower_lower t = p (TL.toLower t) >= p t- where p = TL.length . TL.filter isLower-t_toUpper_length t = T.length (T.toUpper t) >= T.length t-t_toUpper_upper t = p (T.toUpper t) >= p t- where p = T.length . T.filter isUpper-tl_toUpper_upper t = p (TL.toUpper t) >= p t- where p = TL.length . TL.filter isUpper--justifyLeft k c xs = xs ++ L.replicate (k - length xs) c-justifyRight m n xs = L.replicate (m - length xs) n ++ xs-center k c xs- | len >= k = xs- | otherwise = L.replicate l c ++ xs ++ L.replicate r c- where len = length xs- d = k - len- r = d `div` 2- l = d - r--s_justifyLeft k c = justifyLeft j c `eqP` (unpackS . S.justifyLeftI j c)- where j = fromIntegral (k :: Word8)-s_justifyLeft_s k c = justifyLeft j c `eqP`- (unpackS . S.unstream . S.justifyLeftI j c)- where j = fromIntegral (k :: Word8)-sf_justifyLeft p k c = (justifyLeft j c . L.filter p) `eqP`- (unpackS . S.justifyLeftI j c . S.filter p)- where j = fromIntegral (k :: Word8)-t_justifyLeft k c = justifyLeft j c `eqP` (unpackS . T.justifyLeft j c)- where j = fromIntegral (k :: Word8)-tl_justifyLeft k c = justifyLeft j c `eqP`- (unpackS . TL.justifyLeft (fromIntegral j) c)- where j = fromIntegral (k :: Word8)-t_justifyRight k c = justifyRight j c `eqP` (unpackS . T.justifyRight j c)- where j = fromIntegral (k :: Word8)-tl_justifyRight k c = justifyRight j c `eqP`- (unpackS . TL.justifyRight (fromIntegral j) c)- where j = fromIntegral (k :: Word8)-t_center k c = center j c `eqP` (unpackS . T.center j c)- where j = fromIntegral (k :: Word8)-tl_center k c = center j c `eqP` (unpackS . TL.center (fromIntegral j) c)- where j = fromIntegral (k :: Word8)--sf_foldl p f z = (L.foldl f z . L.filter p) `eqP` (S.foldl f z . S.filter p)- where _types = f :: Char -> Char -> Char-t_foldl f z = L.foldl f z `eqP` (T.foldl f z)- where _types = f :: Char -> Char -> Char-tl_foldl f z = L.foldl f z `eqP` (TL.foldl f z)- where _types = f :: Char -> Char -> Char-sf_foldl' p f z = (L.foldl' f z . L.filter p) `eqP`- (S.foldl' f z . S.filter p)- where _types = f :: Char -> Char -> Char-t_foldl' f z = L.foldl' f z `eqP` T.foldl' f z- where _types = f :: Char -> Char -> Char-tl_foldl' f z = L.foldl' f z `eqP` TL.foldl' f z- where _types = f :: Char -> Char -> Char-sf_foldl1 p f = (L.foldl1 f . L.filter p) `eqP` (S.foldl1 f . S.filter p)-t_foldl1 f = L.foldl1 f `eqP` T.foldl1 f-tl_foldl1 f = L.foldl1 f `eqP` TL.foldl1 f-sf_foldl1' p f = (L.foldl1' f . L.filter p) `eqP` (S.foldl1' f . S.filter p)-t_foldl1' f = L.foldl1' f `eqP` T.foldl1' f-tl_foldl1' f = L.foldl1' f `eqP` TL.foldl1' f-sf_foldr p f z = (L.foldr f z . L.filter p) `eqP` (S.foldr f z . S.filter p)- where _types = f :: Char -> Char -> Char-t_foldr f z = L.foldr f z `eqP` T.foldr f z- where _types = f :: Char -> Char -> Char-tl_foldr f z = L.foldr f z `eqP` TL.foldr f z- where _types = f :: Char -> Char -> Char-sf_foldr1 p f = (L.foldr1 f . L.filter p) `eqP` (S.foldr1 f . S.filter p)-t_foldr1 f = L.foldr1 f `eqP` T.foldr1 f-tl_foldr1 f = L.foldr1 f `eqP` TL.foldr1 f--s_concat_s = L.concat `eq` (unpackS . S.unstream . S.concat . map packS)-sf_concat p = (L.concat . map (L.filter p)) `eq`- (unpackS . S.concat . map (S.filter p . packS))-t_concat = L.concat `eq` (unpackS . T.concat . map packS)-tl_concat = L.concat `eq` (unpackS . TL.concat . map TL.pack)-sf_concatMap p f = unsquare $ (L.concatMap f . L.filter p) `eqP`- (unpackS . S.concatMap (packS . f) . S.filter p)-t_concatMap f = unsquare $- L.concatMap f `eqP` (unpackS . T.concatMap (packS . f))-tl_concatMap f = unsquare $- L.concatMap f `eqP` (unpackS . TL.concatMap (TL.pack . f))-sf_any q p = (L.any p . L.filter q) `eqP` (S.any p . S.filter q)-t_any p = L.any p `eqP` T.any p-tl_any p = L.any p `eqP` TL.any p-sf_all q p = (L.all p . L.filter q) `eqP` (S.all p . S.filter q)-t_all p = L.all p `eqP` T.all p-tl_all p = L.all p `eqP` TL.all p-sf_maximum p = (L.maximum . L.filter p) `eqP` (S.maximum . S.filter p)-t_maximum = L.maximum `eqP` T.maximum-tl_maximum = L.maximum `eqP` TL.maximum-sf_minimum p = (L.minimum . L.filter p) `eqP` (S.minimum . S.filter p)-t_minimum = L.minimum `eqP` T.minimum-tl_minimum = L.minimum `eqP` TL.minimum--sf_scanl p f z = (L.scanl f z . L.filter p) `eqP`- (unpackS . S.scanl f z . S.filter p)-t_scanl f z = L.scanl f z `eqP` (unpackS . T.scanl f z)-tl_scanl f z = L.scanl f z `eqP` (unpackS . TL.scanl f z)-t_scanl1 f = L.scanl1 f `eqP` (unpackS . T.scanl1 f)-tl_scanl1 f = L.scanl1 f `eqP` (unpackS . TL.scanl1 f)-t_scanr f z = L.scanr f z `eqP` (unpackS . T.scanr f z)-tl_scanr f z = L.scanr f z `eqP` (unpackS . TL.scanr f z)-t_scanr1 f = L.scanr1 f `eqP` (unpackS . T.scanr1 f)-tl_scanr1 f = L.scanr1 f `eqP` (unpackS . TL.scanr1 f)--t_mapAccumL f z = L.mapAccumL f z `eqP` (second unpackS . T.mapAccumL f z)- where _types = f :: Int -> Char -> (Int,Char)-tl_mapAccumL f z = L.mapAccumL f z `eqP` (second unpackS . TL.mapAccumL f z)- where _types = f :: Int -> Char -> (Int,Char)-t_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . T.mapAccumR f z)- where _types = f :: Int -> Char -> (Int,Char)-tl_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . TL.mapAccumR f z)- where _types = f :: Int -> Char -> (Int,Char)--replicate n l = concat (L.replicate n l)--s_replicate n = replicate m `eq`- (unpackS . S.replicateI (fromIntegral m) . packS)- where m = fromIntegral (n :: Word8)-t_replicate n = replicate m `eq` (unpackS . T.replicate m . packS)- where m = fromIntegral (n :: Word8)-tl_replicate n = replicate m `eq`- (unpackS . TL.replicate (fromIntegral m) . packS)- where m = fromIntegral (n :: Word8)--unf :: Int -> Char -> Maybe (Char, Char)-unf n c | fromEnum c * 100 > n = Nothing- | otherwise = Just (c, succ c)--t_unfoldr n = L.unfoldr (unf m) `eq` (unpackS . T.unfoldr (unf m))- where m = fromIntegral (n :: Word16)-tl_unfoldr n = L.unfoldr (unf m) `eq` (unpackS . TL.unfoldr (unf m))- where m = fromIntegral (n :: Word16)-t_unfoldrN n m = (L.take i . L.unfoldr (unf j)) `eq`- (unpackS . T.unfoldrN i (unf j))- where i = fromIntegral (n :: Word16)- j = fromIntegral (m :: Word16)-tl_unfoldrN n m = (L.take i . L.unfoldr (unf j)) `eq`- (unpackS . TL.unfoldrN (fromIntegral i) (unf j))- where i = fromIntegral (n :: Word16)- j = fromIntegral (m :: Word16)--unpack2 :: (Stringy s) => (s,s) -> (String,String)-unpack2 = unpackS *** unpackS--s_take n = L.take n `eqP` (unpackS . S.take n)-s_take_s m = L.take n `eqP` (unpackS . S.unstream . S.take n)- where n = small m-sf_take p n = (L.take n . L.filter p) `eqP`- (unpackS . S.take n . S.filter p)-t_take n = L.take n `eqP` (unpackS . T.take n)-tl_take n = L.take n `eqP` (unpackS . TL.take (fromIntegral n))-s_drop n = L.drop n `eqP` (unpackS . S.drop n)-s_drop_s m = L.drop n `eqP` (unpackS . S.unstream . S.drop n)- where n = small m-sf_drop p n = (L.drop n . L.filter p) `eqP`- (unpackS . S.drop n . S.filter p)-t_drop n = L.drop n `eqP` (unpackS . T.drop n)-tl_drop n = L.drop n `eqP` (unpackS . TL.drop (fromIntegral n))-s_take_drop m = (L.take n . L.drop n) `eqP` (unpackS . S.take n . S.drop n)- where n = small m-s_take_drop_s m = (L.take n . L.drop n) `eqP`- (unpackS . S.unstream . S.take n . S.drop n)- where n = small m-s_takeWhile p = L.takeWhile p `eqP` (unpackS . S.takeWhile p)-s_takeWhile_s p = L.takeWhile p `eqP` (unpackS . S.unstream . S.takeWhile p)-sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP`- (unpackS . S.takeWhile p . S.filter q)-t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)-tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)-s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)-s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)-sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`- (unpackS . S.dropWhile p . S.filter q)-t_dropWhile p = L.dropWhile p `eqP` (unpackS . T.dropWhile p)-tl_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)-t_dropWhileEnd p = (L.reverse . L.dropWhile p . L.reverse) `eqP`- (unpackS . T.dropWhileEnd p)-tl_dropWhileEnd p = (L.reverse . L.dropWhile p . L.reverse) `eqP`- (unpackS . TL.dropWhileEnd p)-t_dropAround p = (L.dropWhile p . L.reverse . L.dropWhile p . L.reverse)- `eqP` (unpackS . T.dropAround p)-tl_dropAround p = (L.dropWhile p . L.reverse . L.dropWhile p . L.reverse)- `eqP` (unpackS . TL.dropAround p)-t_stripStart = T.dropWhile isSpace `eq` T.stripStart-tl_stripStart = TL.dropWhile isSpace `eq` TL.stripStart-t_stripEnd = T.dropWhileEnd isSpace `eq` T.stripEnd-tl_stripEnd = TL.dropWhileEnd isSpace `eq` TL.stripEnd-t_strip = T.dropAround isSpace `eq` T.strip-tl_strip = TL.dropAround isSpace `eq` TL.strip-t_splitAt n = L.splitAt n `eqP` (unpack2 . T.splitAt n)-tl_splitAt n = L.splitAt n `eqP` (unpack2 . TL.splitAt (fromIntegral n))-t_span p = L.span p `eqP` (unpack2 . T.span p)-tl_span p = L.span p `eqP` (unpack2 . TL.span p)--t_breakOn_id s = squid `eq` (uncurry T.append . T.breakOn s)- where squid t | T.null s = error "empty"- | otherwise = t-tl_breakOn_id s = squid `eq` (uncurry TL.append . TL.breakOn s)- where squid t | TL.null s = error "empty"- | otherwise = t-t_breakOn_start (NotEmpty s) t =- let (k,m) = T.breakOn s t- in k `T.isPrefixOf` t && (T.null m || s `T.isPrefixOf` m)-tl_breakOn_start (NotEmpty s) t =- let (k,m) = TL.breakOn s t- in k `TL.isPrefixOf` t && TL.null m || s `TL.isPrefixOf` m-t_breakOnEnd_end (NotEmpty s) t =- let (m,k) = T.breakOnEnd s t- in k `T.isSuffixOf` t && (T.null m || s `T.isSuffixOf` m)-tl_breakOnEnd_end (NotEmpty s) t =- let (m,k) = TL.breakOnEnd s t- in k `TL.isSuffixOf` t && (TL.null m || s `TL.isSuffixOf` m)-t_break p = L.break p `eqP` (unpack2 . T.break p)-tl_break p = L.break p `eqP` (unpack2 . TL.break p)-t_group = L.group `eqP` (map unpackS . T.group)-tl_group = L.group `eqP` (map unpackS . TL.group)-t_groupBy p = L.groupBy p `eqP` (map unpackS . T.groupBy p)-tl_groupBy p = L.groupBy p `eqP` (map unpackS . TL.groupBy p)-t_inits = L.inits `eqP` (map unpackS . T.inits)-tl_inits = L.inits `eqP` (map unpackS . TL.inits)-t_tails = L.tails `eqP` (map unpackS . T.tails)-tl_tails = L.tails `eqP` (map unpackS . TL.tails)-t_findAppendId (NotEmpty s) = unsquare $ \ts ->- let t = T.intercalate s ts- in all (==t) $ map (uncurry T.append) (T.breakOnAll s t)-tl_findAppendId (NotEmpty s) = unsquare $ \ts ->- let t = TL.intercalate s ts- in all (==t) $ map (uncurry TL.append) (TL.breakOnAll s t)-t_findContains (NotEmpty s) = all (T.isPrefixOf s . snd) . T.breakOnAll s .- T.intercalate s-tl_findContains (NotEmpty s) = all (TL.isPrefixOf s . snd) .- TL.breakOnAll s . TL.intercalate s-sl_filterCount c = (L.genericLength . L.filter (==c)) `eqP` SL.countChar c-t_findCount s = (L.length . T.breakOnAll s) `eq` T.count s-tl_findCount s = (L.genericLength . TL.breakOnAll s) `eq` TL.count s--t_splitOn_split s = (T.splitOn s `eq` Slow.splitOn s) . T.intercalate s-tl_splitOn_split s = ((TL.splitOn (TL.fromStrict s) . TL.fromStrict) `eq`- (map TL.fromStrict . T.splitOn s)) . T.intercalate s-t_splitOn_i (NotEmpty t) = id `eq` (T.intercalate t . T.splitOn t)-tl_splitOn_i (NotEmpty t) = id `eq` (TL.intercalate t . TL.splitOn t)--t_split p = split p `eqP` (map unpackS . T.split p)-t_split_count c = (L.length . T.split (==c)) `eq`- ((1+) . T.count (T.singleton c))-t_split_splitOn c = T.split (==c) `eq` T.splitOn (T.singleton c)-tl_split p = split p `eqP` (map unpackS . TL.split p)--split :: (a -> Bool) -> [a] -> [[a]]-split _ [] = [[]]-split p xs = loop xs- where loop s | null s' = [l]- | otherwise = l : loop (tail s')- where (l, s') = break p s--t_chunksOf_same_lengths k = all ((==k) . T.length) . ini . T.chunksOf k- where ini [] = []- ini xs = init xs--t_chunksOf_length k t = len == T.length t || (k <= 0 && len == 0)- where len = L.sum . L.map T.length $ T.chunksOf k t--tl_chunksOf k = T.chunksOf k `eq` (map (T.concat . TL.toChunks) .- TL.chunksOf (fromIntegral k) . TL.fromStrict)--t_lines = L.lines `eqP` (map unpackS . T.lines)-tl_lines = L.lines `eqP` (map unpackS . TL.lines)-{--t_lines' = lines' `eqP` (map unpackS . 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'--}-t_words = L.words `eqP` (map unpackS . T.words)--tl_words = L.words `eqP` (map unpackS . TL.words)-t_unlines = L.unlines `eq` (unpackS . T.unlines . map packS)-tl_unlines = L.unlines `eq` (unpackS . TL.unlines . map packS)-t_unwords = L.unwords `eq` (unpackS . T.unwords . map packS)-tl_unwords = L.unwords `eq` (unpackS . TL.unwords . map packS)--s_isPrefixOf s = L.isPrefixOf s `eqP`- (S.isPrefixOf (S.stream $ packS s) . S.stream)-sf_isPrefixOf p s = (L.isPrefixOf s . L.filter p) `eqP`- (S.isPrefixOf (S.stream $ packS s) . S.filter p . S.stream)-t_isPrefixOf s = L.isPrefixOf s`eqP` T.isPrefixOf (packS s)-tl_isPrefixOf s = L.isPrefixOf s`eqP` TL.isPrefixOf (packS s)-t_isSuffixOf s = L.isSuffixOf s`eqP` T.isSuffixOf (packS s)-tl_isSuffixOf s = L.isSuffixOf s`eqP` TL.isSuffixOf (packS s)-t_isInfixOf s = L.isInfixOf s `eqP` T.isInfixOf (packS s)-tl_isInfixOf s = L.isInfixOf s `eqP` TL.isInfixOf (packS s)--t_stripPrefix s = (fmap packS . L.stripPrefix s) `eqP` T.stripPrefix (packS s)-tl_stripPrefix s = (fmap packS . L.stripPrefix s) `eqP` TL.stripPrefix (packS s)--stripSuffix p t = reverse `fmap` L.stripPrefix (reverse p) (reverse t)--t_stripSuffix s = (fmap packS . stripSuffix s) `eqP` T.stripSuffix (packS s)-tl_stripSuffix s = (fmap packS . stripSuffix s) `eqP` TL.stripSuffix (packS s)--commonPrefixes a0@(_:_) b0@(_:_) = Just (go a0 b0 [])- where go (a:as) (b:bs) ps- | a == b = go as bs (a:ps)- go as bs ps = (reverse ps,as,bs)-commonPrefixes _ _ = Nothing--t_commonPrefixes a b (NonEmpty p)- = commonPrefixes pa pb ==- repack `fmap` T.commonPrefixes (packS pa) (packS pb)- where repack (x,y,z) = (unpackS x,unpackS y,unpackS z)- pa = p ++ a- pb = p ++ b--tl_commonPrefixes a b (NonEmpty p)- = commonPrefixes pa pb ==- repack `fmap` TL.commonPrefixes (packS pa) (packS pb)- where repack (x,y,z) = (unpackS x,unpackS y,unpackS z)- pa = p ++ a- pb = p ++ b--sf_elem p c = (L.elem c . L.filter p) `eqP` (S.elem c . S.filter p)-sf_filter q p = (L.filter p . L.filter q) `eqP`- (unpackS . S.filter p . S.filter q)-t_filter p = L.filter p `eqP` (unpackS . T.filter p)-tl_filter p = L.filter p `eqP` (unpackS . TL.filter p)-sf_findBy q p = (L.find p . L.filter q) `eqP` (S.findBy p . S.filter q)-t_find p = L.find p `eqP` T.find p-tl_find p = L.find p `eqP` TL.find p-t_partition p = L.partition p `eqP` (unpack2 . T.partition p)-tl_partition p = L.partition p `eqP` (unpack2 . TL.partition p)--sf_index p s = forAll (choose (-l,l*2))- ((L.filter p s L.!!) `eq` S.index (S.filter p $ packS s))- where l = L.length s-t_index s = forAll (choose (-l,l*2)) ((s L.!!) `eq` T.index (packS s))- where l = L.length s--tl_index s = forAll (choose (-l,l*2))- ((s L.!!) `eq` (TL.index (packS s) . fromIntegral))- where l = L.length s--t_findIndex p = L.findIndex p `eqP` T.findIndex p-t_count (NotEmpty t) = (subtract 1 . L.length . T.splitOn t) `eq` T.count t-tl_count (NotEmpty t) = (subtract 1 . L.genericLength . TL.splitOn t) `eq`- TL.count t-t_zip s = L.zip s `eqP` T.zip (packS s)-tl_zip s = L.zip s `eqP` TL.zip (packS s)-sf_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)-t_zipWith c s = L.zipWith c s `eqP` (unpackS . T.zipWith c (packS s))-tl_zipWith c s = L.zipWith c s `eqP` (unpackS . TL.zipWith c (packS s))--t_indices (NotEmpty s) = Slow.indices s `eq` indices s-tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s- where lazyIndices ss t = map fromIntegral $ Slow.indices (conc ss) (conc t)- conc = T.concat . TL.toChunks-t_indices_occurs (NotEmpty t) ts = let s = T.intercalate t ts- in Slow.indices t s == indices t s---- Bit shifts.-shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k- where width = round (log (fromIntegral m) / log 2 :: Double)- (m,_) = (maxBound, m == w)-shiftR w = forAll (choose (0,width-1)) $ \k -> Bits.shiftR w k == U.shiftR w k- where width = round (log (fromIntegral m) / log 2 :: Double)- (m,_) = (maxBound, m == w)--shiftL_Int = shiftL :: Int -> Property-shiftL_Word16 = shiftL :: Word16 -> Property-shiftL_Word32 = shiftL :: Word32 -> Property-shiftR_Int = shiftR :: Int -> Property-shiftR_Word16 = shiftR :: Word16 -> Property-shiftR_Word32 = shiftR :: Word32 -> Property---- Builder.--t_builderSingleton = id `eqP`- (unpackS . TB.toLazyText . mconcat . map TB.singleton)-t_builderFromText = L.concat `eq` (unpackS . TB.toLazyText . mconcat .- map (TB.fromText . packS))-t_builderAssociative s1 s2 s3 =- TB.toLazyText (b1 `mappend` (b2 `mappend` b3)) ==- TB.toLazyText ((b1 `mappend` b2) `mappend` b3)- where b1 = TB.fromText (packS s1)- b2 = TB.fromText (packS s2)- b3 = TB.fromText (packS s3)---- Reading.--t_decimal (n::Int) s =- T.signed T.decimal (T.pack (show n) `T.append` t) == Right (n,t)- where t = T.dropWhile isDigit s-tl_decimal (n::Int) s =- TL.signed TL.decimal (TL.pack (show n) `TL.append` t) == Right (n,t)- where t = TL.dropWhile isDigit s-t_hexadecimal (n::Positive Int) s ox =- T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) == Right (n,t)- where t = T.dropWhile isHexDigit s- p = if ox then "0x" else ""-tl_hexadecimal (n::Positive Int) s ox =- TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) == Right (n,t)- where t = TL.dropWhile isHexDigit s- p = if ox then "0x" else ""--isFloaty c = c `elem` "+-.0123456789eE"--t_read_rational p tol (n::Double) s =- case p (T.pack (show n) `T.append` t) of- Left _err -> False- Right (n',t') -> t == t' && abs (n-n') <= tol- where t = T.dropWhile isFloaty s--tl_read_rational p tol (n::Double) s =- case p (TL.pack (show n) `TL.append` t) of- Left _err -> False- Right (n',t') -> t == t' && abs (n-n') <= tol- where t = TL.dropWhile isFloaty s--t_double = t_read_rational T.double 1e-13-tl_double = tl_read_rational TL.double 1e-13-t_rational = t_read_rational T.rational 1e-16-tl_rational = tl_read_rational TL.rational 1e-16---- Input and output.--t_put_get = write_read T.unlines T.filter put get- where put h = withRedirect h IO.stdout . T.putStr- get h = withRedirect h IO.stdin T.getContents-tl_put_get = write_read TL.unlines TL.filter put get- where put h = withRedirect h IO.stdout . TL.putStr- get h = withRedirect h IO.stdin TL.getContents-t_write_read = write_read T.unlines T.filter T.hPutStr T.hGetContents-tl_write_read = write_read TL.unlines TL.filter TL.hPutStr TL.hGetContents--t_write_read_line e m b t = write_read head T.filter T.hPutStrLn- T.hGetLine e m b [t]-tl_write_read_line e m b t = write_read head TL.filter TL.hPutStrLn- TL.hGetLine e m b [t]---- Low-level.--t_dropWord16 m t = dropWord16 m t `T.isSuffixOf` t-t_takeWord16 m t = takeWord16 m t `T.isPrefixOf` t-t_take_drop_16 m t = T.append (takeWord16 n t) (dropWord16 n t) == t- where n = small m-t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)---- Regression tests.-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 > 0 = S.Stream arr off (smaller (exactSize n) len) - | otherwise = t--tests :: Test-tests =- testGroup "Properties" [- testGroup "creation/elimination" [- testProperty "t_pack_unpack" t_pack_unpack,- testProperty "tl_pack_unpack" tl_pack_unpack,- testProperty "t_stream_unstream" t_stream_unstream,- testProperty "tl_stream_unstream" tl_stream_unstream,- testProperty "t_reverse_stream" t_reverse_stream,- testProperty "t_singleton" t_singleton,- testProperty "tl_singleton" tl_singleton,- testProperty "tl_unstreamChunks" tl_unstreamChunks,- testProperty "tl_chunk_unchunk" tl_chunk_unchunk,- testProperty "tl_from_to_strict" tl_from_to_strict- ],-- testGroup "transcoding" [- testProperty "t_ascii" t_ascii,- testProperty "tl_ascii" tl_ascii,- testProperty "t_utf8" t_utf8,- testProperty "t_utf8'" t_utf8',- testProperty "tl_utf8" tl_utf8,- testProperty "tl_utf8'" tl_utf8',- testProperty "t_utf16LE" t_utf16LE,- testProperty "tl_utf16LE" tl_utf16LE,- testProperty "t_utf16BE" t_utf16BE,- testProperty "tl_utf16BE" tl_utf16BE,- testProperty "t_utf32LE" t_utf32LE,- testProperty "tl_utf32LE" tl_utf32LE,- testProperty "t_utf32BE" t_utf32BE,- testProperty "tl_utf32BE" tl_utf32BE,- testGroup "errors" [- testProperty "t_utf8_err" t_utf8_err,- testProperty "t_utf8_err'" t_utf8_err'- ]- ],-- testGroup "instances" [- testProperty "s_Eq" s_Eq,- testProperty "sf_Eq" sf_Eq,- testProperty "t_Eq" t_Eq,- testProperty "tl_Eq" tl_Eq,- testProperty "s_Ord" s_Ord,- testProperty "sf_Ord" sf_Ord,- testProperty "t_Ord" t_Ord,- testProperty "tl_Ord" tl_Ord,- testProperty "t_Read" t_Read,- testProperty "tl_Read" tl_Read,- testProperty "t_Show" t_Show,- testProperty "tl_Show" tl_Show,- testProperty "t_mappend" t_mappend,- testProperty "tl_mappend" tl_mappend,- testProperty "t_mconcat" t_mconcat,- testProperty "tl_mconcat" tl_mconcat,- testProperty "t_mempty" t_mempty,- testProperty "tl_mempty" tl_mempty,- testProperty "t_IsString" t_IsString,- testProperty "tl_IsString" tl_IsString- ],-- testGroup "basics" [- testProperty "s_cons" s_cons,- testProperty "s_cons_s" s_cons_s,- testProperty "sf_cons" sf_cons,- testProperty "t_cons" t_cons,- testProperty "tl_cons" tl_cons,- testProperty "s_snoc" s_snoc,- testProperty "t_snoc" t_snoc,- testProperty "tl_snoc" tl_snoc,- testProperty "s_append" s_append,- testProperty "s_append_s" s_append_s,- testProperty "sf_append" sf_append,- testProperty "t_append" t_append,- testProperty "s_uncons" s_uncons,- testProperty "sf_uncons" sf_uncons,- testProperty "t_uncons" t_uncons,- testProperty "tl_uncons" tl_uncons,- testProperty "s_head" s_head,- testProperty "sf_head" sf_head,- testProperty "t_head" t_head,- testProperty "tl_head" tl_head,- testProperty "s_last" s_last,- testProperty "sf_last" sf_last,- testProperty "t_last" t_last,- testProperty "tl_last" tl_last,- testProperty "s_tail" s_tail,- testProperty "s_tail_s" s_tail_s,- testProperty "sf_tail" sf_tail,- testProperty "t_tail" t_tail,- testProperty "tl_tail" tl_tail,- testProperty "s_init" s_init,- testProperty "s_init_s" s_init_s,- testProperty "sf_init" sf_init,- testProperty "t_init" t_init,- testProperty "tl_init" tl_init,- testProperty "s_null" s_null,- testProperty "sf_null" sf_null,- testProperty "t_null" t_null,- testProperty "tl_null" tl_null,- testProperty "s_length" s_length,- testProperty "sf_length" sf_length,- testProperty "sl_length" sl_length,- testProperty "t_length" t_length,- testProperty "tl_length" tl_length,- testProperty "t_compareLength" t_compareLength,- testProperty "tl_compareLength" tl_compareLength- ],-- testGroup "transformations" [- testProperty "s_map" s_map,- testProperty "s_map_s" s_map_s,- testProperty "sf_map" sf_map,- testProperty "t_map" t_map,- testProperty "tl_map" tl_map,- testProperty "s_intercalate" s_intercalate,- testProperty "t_intercalate" t_intercalate,- testProperty "tl_intercalate" tl_intercalate,- testProperty "s_intersperse" s_intersperse,- testProperty "s_intersperse_s" s_intersperse_s,- testProperty "sf_intersperse" sf_intersperse,- testProperty "t_intersperse" t_intersperse,- testProperty "tl_intersperse" tl_intersperse,- testProperty "t_transpose" t_transpose,- testProperty "tl_transpose" tl_transpose,- testProperty "t_reverse" t_reverse,- testProperty "tl_reverse" tl_reverse,- testProperty "t_reverse_short" t_reverse_short,- testProperty "t_replace" t_replace,- testProperty "tl_replace" tl_replace,-- testGroup "case conversion" [- testProperty "s_toCaseFold_length" s_toCaseFold_length,- testProperty "sf_toCaseFold_length" sf_toCaseFold_length,- testProperty "t_toCaseFold_length" t_toCaseFold_length,- testProperty "tl_toCaseFold_length" tl_toCaseFold_length,- testProperty "t_toLower_length" t_toLower_length,- testProperty "t_toLower_lower" t_toLower_lower,- testProperty "tl_toLower_lower" tl_toLower_lower,- testProperty "t_toUpper_length" t_toUpper_length,- testProperty "t_toUpper_upper" t_toUpper_upper,- testProperty "tl_toUpper_upper" tl_toUpper_upper- ],-- testGroup "justification" [- testProperty "s_justifyLeft" s_justifyLeft,- testProperty "s_justifyLeft_s" s_justifyLeft_s,- testProperty "sf_justifyLeft" sf_justifyLeft,- testProperty "t_justifyLeft" t_justifyLeft,- testProperty "tl_justifyLeft" tl_justifyLeft,- testProperty "t_justifyRight" t_justifyRight,- testProperty "tl_justifyRight" tl_justifyRight,- testProperty "t_center" t_center,- testProperty "tl_center" tl_center- ]- ],-- testGroup "folds" [- testProperty "sf_foldl" sf_foldl,- testProperty "t_foldl" t_foldl,- testProperty "tl_foldl" tl_foldl,- testProperty "sf_foldl'" sf_foldl',- testProperty "t_foldl'" t_foldl',- testProperty "tl_foldl'" tl_foldl',- testProperty "sf_foldl1" sf_foldl1,- testProperty "t_foldl1" t_foldl1,- testProperty "tl_foldl1" tl_foldl1,- testProperty "t_foldl1'" t_foldl1',- testProperty "sf_foldl1'" sf_foldl1',- testProperty "tl_foldl1'" tl_foldl1',- testProperty "sf_foldr" sf_foldr,- testProperty "t_foldr" t_foldr,- testProperty "tl_foldr" tl_foldr,- testProperty "sf_foldr1" sf_foldr1,- testProperty "t_foldr1" t_foldr1,- testProperty "tl_foldr1" tl_foldr1,-- testGroup "special" [- testProperty "s_concat_s" s_concat_s,- testProperty "sf_concat" sf_concat,- testProperty "t_concat" t_concat,- testProperty "tl_concat" tl_concat,- testProperty "sf_concatMap" sf_concatMap,- testProperty "t_concatMap" t_concatMap,- testProperty "tl_concatMap" tl_concatMap,- testProperty "sf_any" sf_any,- testProperty "t_any" t_any,- testProperty "tl_any" tl_any,- testProperty "sf_all" sf_all,- testProperty "t_all" t_all,- testProperty "tl_all" tl_all,- testProperty "sf_maximum" sf_maximum,- testProperty "t_maximum" t_maximum,- testProperty "tl_maximum" tl_maximum,- testProperty "sf_minimum" sf_minimum,- testProperty "t_minimum" t_minimum,- testProperty "tl_minimum" tl_minimum- ]- ],-- testGroup "construction" [- testGroup "scans" [- testProperty "sf_scanl" sf_scanl,- testProperty "t_scanl" t_scanl,- testProperty "tl_scanl" tl_scanl,- testProperty "t_scanl1" t_scanl1,- testProperty "tl_scanl1" tl_scanl1,- testProperty "t_scanr" t_scanr,- testProperty "tl_scanr" tl_scanr,- testProperty "t_scanr1" t_scanr1,- testProperty "tl_scanr1" tl_scanr1- ],-- testGroup "mapAccum" [- testProperty "t_mapAccumL" t_mapAccumL,- testProperty "tl_mapAccumL" tl_mapAccumL,- testProperty "t_mapAccumR" t_mapAccumR,- testProperty "tl_mapAccumR" tl_mapAccumR- ],-- testGroup "unfolds" [- testProperty "s_replicate" s_replicate,- testProperty "t_replicate" t_replicate,- testProperty "tl_replicate" tl_replicate,- testProperty "t_unfoldr" t_unfoldr,- testProperty "tl_unfoldr" tl_unfoldr,- testProperty "t_unfoldrN" t_unfoldrN,- testProperty "tl_unfoldrN" tl_unfoldrN- ]- ],-- testGroup "substrings" [- testGroup "breaking" [- testProperty "s_take" s_take,- testProperty "s_take_s" s_take_s,- testProperty "sf_take" sf_take,- testProperty "t_take" t_take,- testProperty "tl_take" tl_take,- testProperty "s_drop" s_drop,- testProperty "s_drop_s" s_drop_s,- testProperty "sf_drop" sf_drop,- testProperty "t_drop" t_drop,- testProperty "tl_drop" tl_drop,- testProperty "s_take_drop" s_take_drop,- testProperty "s_take_drop_s" s_take_drop_s,- testProperty "s_takeWhile" s_takeWhile,- testProperty "s_takeWhile_s" s_takeWhile_s,- testProperty "sf_takeWhile" sf_takeWhile,- testProperty "t_takeWhile" t_takeWhile,- testProperty "tl_takeWhile" tl_takeWhile,- testProperty "sf_dropWhile" sf_dropWhile,- testProperty "s_dropWhile" s_dropWhile,- testProperty "s_dropWhile_s" s_dropWhile_s,- testProperty "t_dropWhile" t_dropWhile,- testProperty "tl_dropWhile" tl_dropWhile,- testProperty "t_dropWhileEnd" t_dropWhileEnd,- testProperty "tl_dropWhileEnd" tl_dropWhileEnd,- testProperty "t_dropAround" t_dropAround,- testProperty "tl_dropAround" tl_dropAround,- testProperty "t_stripStart" t_stripStart,- testProperty "tl_stripStart" tl_stripStart,- testProperty "t_stripEnd" t_stripEnd,- testProperty "tl_stripEnd" tl_stripEnd,- testProperty "t_strip" t_strip,- testProperty "tl_strip" tl_strip,- testProperty "t_splitAt" t_splitAt,- testProperty "tl_splitAt" tl_splitAt,- testProperty "t_span" t_span,- testProperty "tl_span" tl_span,- testProperty "t_breakOn_id" t_breakOn_id,- testProperty "tl_breakOn_id" tl_breakOn_id,- testProperty "t_breakOn_start" t_breakOn_start,- testProperty "tl_breakOn_start" tl_breakOn_start,- testProperty "t_breakOnEnd_end" t_breakOnEnd_end,- testProperty "tl_breakOnEnd_end" tl_breakOnEnd_end,- testProperty "t_break" t_break,- testProperty "tl_break" tl_break,- testProperty "t_group" t_group,- testProperty "tl_group" tl_group,- testProperty "t_groupBy" t_groupBy,- testProperty "tl_groupBy" tl_groupBy,- testProperty "t_inits" t_inits,- testProperty "tl_inits" tl_inits,- testProperty "t_tails" t_tails,- testProperty "tl_tails" tl_tails- ],-- testGroup "breaking many" [- testProperty "t_findAppendId" t_findAppendId,- testProperty "tl_findAppendId" tl_findAppendId,- testProperty "t_findContains" t_findContains,- testProperty "tl_findContains" tl_findContains,- testProperty "sl_filterCount" sl_filterCount,- testProperty "t_findCount" t_findCount,- testProperty "tl_findCount" tl_findCount,- testProperty "t_splitOn_split" t_splitOn_split,- testProperty "tl_splitOn_split" tl_splitOn_split,- testProperty "t_splitOn_i" t_splitOn_i,- testProperty "tl_splitOn_i" tl_splitOn_i,- testProperty "t_split" t_split,- testProperty "t_split_count" t_split_count,- testProperty "t_split_splitOn" t_split_splitOn,- testProperty "tl_split" tl_split,- testProperty "t_chunksOf_same_lengths" t_chunksOf_same_lengths,- testProperty "t_chunksOf_length" t_chunksOf_length,- testProperty "tl_chunksOf" tl_chunksOf- ],-- testGroup "lines and words" [- testProperty "t_lines" t_lines,- testProperty "tl_lines" tl_lines,- --testProperty "t_lines'" t_lines',- testProperty "t_words" t_words,- testProperty "tl_words" tl_words,- testProperty "t_unlines" t_unlines,- testProperty "tl_unlines" tl_unlines,- testProperty "t_unwords" t_unwords,- testProperty "tl_unwords" tl_unwords- ]- ],-- testGroup "predicates" [- testProperty "s_isPrefixOf" s_isPrefixOf,- testProperty "sf_isPrefixOf" sf_isPrefixOf,- testProperty "t_isPrefixOf" t_isPrefixOf,- testProperty "tl_isPrefixOf" tl_isPrefixOf,- testProperty "t_isSuffixOf" t_isSuffixOf,- testProperty "tl_isSuffixOf" tl_isSuffixOf,- testProperty "t_isInfixOf" t_isInfixOf,- testProperty "tl_isInfixOf" tl_isInfixOf,-- testGroup "view" [- testProperty "t_stripPrefix" t_stripPrefix,- testProperty "tl_stripPrefix" tl_stripPrefix,- testProperty "t_stripSuffix" t_stripSuffix,- testProperty "tl_stripSuffix" tl_stripSuffix,- testProperty "t_commonPrefixes" t_commonPrefixes,- testProperty "tl_commonPrefixes" tl_commonPrefixes- ]- ],-- testGroup "searching" [- testProperty "sf_elem" sf_elem,- testProperty "sf_filter" sf_filter,- testProperty "t_filter" t_filter,- testProperty "tl_filter" tl_filter,- testProperty "sf_findBy" sf_findBy,- testProperty "t_find" t_find,- testProperty "tl_find" tl_find,- testProperty "t_partition" t_partition,- testProperty "tl_partition" tl_partition- ],-- testGroup "indexing" [- testProperty "sf_index" sf_index,- testProperty "t_index" t_index,- testProperty "tl_index" tl_index,- testProperty "t_findIndex" t_findIndex,- testProperty "t_count" t_count,- testProperty "tl_count" tl_count,- testProperty "t_indices" t_indices,- testProperty "tl_indices" tl_indices,- testProperty "t_indices_occurs" t_indices_occurs- ],-- testGroup "zips" [- testProperty "t_zip" t_zip,- testProperty "tl_zip" tl_zip,- testProperty "sf_zipWith" sf_zipWith,- testProperty "t_zipWith" t_zipWith,- testProperty "tl_zipWith" tl_zipWith- ],-- testGroup "regressions" [- testProperty "s_filter_eq" s_filter_eq- ],-- testGroup "shifts" [- testProperty "shiftL_Int" shiftL_Int,- testProperty "shiftL_Word16" shiftL_Word16,- testProperty "shiftL_Word32" shiftL_Word32,- testProperty "shiftR_Int" shiftR_Int,- testProperty "shiftR_Word16" shiftR_Word16,- testProperty "shiftR_Word32" shiftR_Word32- ],-- testGroup "builder" [- testProperty "t_builderSingleton" t_builderSingleton,- testProperty "t_builderFromText" t_builderFromText,- testProperty "t_builderAssociative" t_builderAssociative- ],-- testGroup "read" [- testProperty "t_decimal" t_decimal,- testProperty "tl_decimal" tl_decimal,- testProperty "t_hexadecimal" t_hexadecimal,- testProperty "tl_hexadecimal" tl_hexadecimal,- testProperty "t_double" t_double,- testProperty "tl_double" tl_double,- testProperty "t_rational" t_rational,- testProperty "tl_rational" tl_rational- ],-- {-- testGroup "input-output" [- testProperty "t_write_read" t_write_read,- testProperty "tl_write_read" tl_write_read,- testProperty "t_write_read_line" t_write_read_line,- testProperty "tl_write_read_line" tl_write_read_line- -- These tests are subject to I/O race conditions when run under- -- test-framework-quickcheck2.- -- testProperty "t_put_get" t_put_get- -- testProperty "tl_put_get" tl_put_get- ],- -}-- testGroup "lowlevel" [- testProperty "t_dropWord16" t_dropWord16,- testProperty "t_takeWord16" t_takeWord16,- testProperty "t_take_drop_16" t_take_drop_16,- testProperty "t_use_from" t_use_from- ]- ]
− tests/tests/src/Data/Text/Tests/QuickCheckUtils.hs
@@ -1,337 +0,0 @@--- | This module provides quickcheck utilities, e.g. arbitrary and show--- instances, and comparison functions, so we can focus on the actual properties--- in the 'Data.Text.Tests.Properties' module.----{-# LANGUAGE CPP, FlexibleInstances, TypeSynonymInstances #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-module Data.Text.Tests.QuickCheckUtils- (- genUnicode- , unsquare- , smallArbitrary-- , NotEmpty (..)-- , Small (..)- , small-- , integralRandomR-- , DecodeErr (..)-- , Stringy (..)- , eq- , eqP-- , Encoding (..)- - , write_read- ) where--import Control.Arrow (first, (***))-import Control.DeepSeq (NFData (..), deepseq)-import Control.Exception (bracket)-import Data.Bits ((.&.))-import Data.Char (chr)-import Data.Word (Word8, Word16)-import Data.String (IsString, fromString)-import Data.Text.Foreign (I16)-import Debug.Trace (trace)-import System.Random (Random (..), RandomGen)-import Test.QuickCheck hiding ((.&.))-import Test.QuickCheck.Monadic (assert, monadicIO, run)-import qualified Data.ByteString as B-import qualified Data.Text as T-import qualified Data.Text.Encoding.Error as T-import qualified Data.Text.Fusion as TF-import qualified Data.Text.Fusion.Common as TF-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Fusion as TLF-import qualified Data.Text.Lazy.Internal as TL-import qualified System.IO as IO--import Data.Text.Tests.Utils--instance Random I16 where- randomR = integralRandomR- random = randomR (minBound,maxBound)--instance Arbitrary I16 where- arbitrary = choose (minBound,maxBound)--instance Arbitrary B.ByteString where- arbitrary = B.pack `fmap` arbitrary--genUnicode :: IsString a => Gen a-genUnicode = fmap fromString string where- string = sized $ \n ->- do k <- choose (0,n)- sequence [ char | _ <- [1..k] ]- - excluding :: [a -> Bool] -> Gen a -> Gen a- excluding bad gen = loop- where- loop = do- x <- gen- if or (map ($ x) bad)- then loop- else return x- - reserved = [lowSurrogate, highSurrogate, noncharacter]- lowSurrogate c = c >= 0xDC00 && c <= 0xDFFF- highSurrogate c = c >= 0xD800 && c <= 0xDBFF- noncharacter c = masked == 0xFFFE || masked == 0xFFFF- where- masked = c .&. 0xFFFF - - ascii = choose (0,0x7F)- plane0 = choose (0xF0, 0xFFFF)- plane1 = oneof [ choose (0x10000, 0x10FFF)- , choose (0x11000, 0x11FFF)- , choose (0x12000, 0x12FFF)- , choose (0x13000, 0x13FFF)- , choose (0x1D000, 0x1DFFF)- , choose (0x1F000, 0x1FFFF)- ]- plane2 = oneof [ choose (0x20000, 0x20FFF)- , choose (0x21000, 0x21FFF)- , choose (0x22000, 0x22FFF)- , choose (0x23000, 0x23FFF)- , choose (0x24000, 0x24FFF)- , choose (0x25000, 0x25FFF)- , choose (0x26000, 0x26FFF)- , choose (0x27000, 0x27FFF)- , choose (0x28000, 0x28FFF)- , choose (0x29000, 0x29FFF)- , choose (0x2A000, 0x2AFFF)- , choose (0x2B000, 0x2BFFF)- , choose (0x2F000, 0x2FFFF)- ]- plane14 = choose (0xE0000, 0xE0FFF)- planes = [ascii, plane0, plane1, plane2, plane14]- - char = chr `fmap` excluding reserved (oneof planes)---- For tests that have O(n^2) running times or input sizes, resize--- their inputs to the square root of the originals.-unsquare :: (Arbitrary a, Show a, Testable b) => (a -> b) -> Property-unsquare = forAll smallArbitrary--smallArbitrary :: (Arbitrary a, Show a) => Gen a-smallArbitrary = sized $ \n -> resize (smallish n) arbitrary- where smallish = round . (sqrt :: Double -> Double) . fromIntegral . abs--instance Arbitrary T.Text where- arbitrary = T.pack `fmap` arbitrary--instance Arbitrary TL.Text where- arbitrary = (TL.fromChunks . map notEmpty) `fmap` smallArbitrary--newtype NotEmpty a = NotEmpty { notEmpty :: a }- deriving (Eq, Ord)--instance Show a => Show (NotEmpty a) where- show (NotEmpty a) = show a--instance Functor NotEmpty where- fmap f (NotEmpty a) = NotEmpty (f a)--instance Arbitrary a => Arbitrary (NotEmpty [a]) where- arbitrary = sized (\n -> NotEmpty `fmap` (choose (1,n+1) >>= vector))--instance Arbitrary (NotEmpty T.Text) where- arbitrary = (fmap T.pack) `fmap` arbitrary--instance Arbitrary (NotEmpty TL.Text) where- arbitrary = (fmap TL.pack) `fmap` arbitrary--instance Arbitrary (NotEmpty B.ByteString) where- arbitrary = (fmap B.pack) `fmap` arbitrary--data Small = S0 | S1 | S2 | S3 | S4 | S5 | S6 | S7- | S8 | S9 | S10 | S11 | S12 | S13 | S14 | S15- | S16 | S17 | S18 | S19 | S20 | S21 | S22 | S23- | S24 | S25 | S26 | S27 | S28 | S29 | S30 | S31- deriving (Eq, Ord, Enum, Bounded)--small :: Integral a => Small -> a-small = fromIntegral . fromEnum--intf :: (Int -> Int -> Int) -> Small -> Small -> Small-intf f a b = toEnum ((fromEnum a `f` fromEnum b) `mod` 32)--instance Show Small where- show = show . fromEnum--instance Read Small where- readsPrec n = map (first toEnum) . readsPrec n--instance Num Small where- fromInteger = toEnum . fromIntegral- signum _ = 1- abs = id- (+) = intf (+)- (-) = intf (-)- (*) = intf (*)--instance Real Small where- toRational = toRational . fromEnum--instance Integral Small where- toInteger = toInteger . fromEnum- quotRem a b = (toEnum x, toEnum y)- where (x, y) = fromEnum a `quotRem` fromEnum b--instance Random Small where- randomR = integralRandomR- random = randomR (minBound,maxBound)--instance Arbitrary Small where- arbitrary = choose (minBound,maxBound)--integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)-integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,- fromIntegral b :: Integer) g of- (x,h) -> (fromIntegral x, h)--data DecodeErr = DE String T.OnDecodeError--instance Show DecodeErr where- show (DE d _) = "DE " ++ d--instance Arbitrary DecodeErr where- arbitrary = oneof [ return $ DE "lenient" T.lenientDecode- , return $ DE "ignore" T.ignore- , return $ DE "strict" T.strictDecode- , DE "replace" `fmap` arbitrary ]--class Stringy s where- packS :: String -> s- unpackS :: s -> String- splitAtS :: Int -> s -> (s,s)- packSChunkSize :: Int -> String -> s- packSChunkSize _ = packS--instance Stringy String where- packS = id- unpackS = id- splitAtS = splitAt--instance Stringy (TF.Stream Char) where- packS = TF.streamList- unpackS = TF.unstreamList- splitAtS n s = (TF.take n s, TF.drop n s)--instance Stringy T.Text where- packS = T.pack- unpackS = T.unpack- splitAtS = T.splitAt--instance Stringy TL.Text where- packSChunkSize k = TLF.unstreamChunks k . TF.streamList- packS = TL.pack- unpackS = TL.unpack- splitAtS = ((TL.lazyInvariant *** TL.lazyInvariant) .) .- TL.splitAt . fromIntegral---- Do two functions give the same answer?-eq :: (Eq a, Show a) => (t -> a) -> (t -> a) -> t -> Bool-eq a b s = a s =^= b s---- What about with the RHS packed?-eqP :: (Eq a, Show a, Stringy s) =>- (String -> a) -> (s -> a) -> String -> Word8 -> Bool-eqP f g s w = eql "orig" (f s) (g t) &&- eql "mini" (f s) (g mini) &&- eql "head" (f sa) (g ta) &&- eql "tail" (f sb) (g tb)- where t = packS s- mini = packSChunkSize 10 s- (sa,sb) = splitAt m s- (ta,tb) = splitAtS m t- l = length s- m | l == 0 = n- | otherwise = n `mod` l- n = fromIntegral w- eql d a b- | a =^= b = True- | otherwise = trace (d ++ ": " ++ show a ++ " /= " ++ show b) False---- Work around lack of Show instance for TextEncoding.-data Encoding = E String IO.TextEncoding--instance Show Encoding where show (E n _) = "utf" ++ n--instance Arbitrary Encoding where- arbitrary = oneof . map return $- [ E "8" IO.utf8, E "8_bom" IO.utf8_bom, E "16" IO.utf16- , E "16le" IO.utf16le, E "16be" IO.utf16be, E "32" IO.utf32- , E "32le" IO.utf32le, E "32be" IO.utf32be- ]--windowsNewlineMode :: IO.NewlineMode-windowsNewlineMode = IO.NewlineMode- { IO.inputNL = IO.CRLF, IO.outputNL = IO.CRLF- }---- Newline and NewlineMode have standard Show instance from GHC 7 onwards-#if __GLASGOW_HASKELL__ < 700-instance Show IO.Newline where- show IO.CRLF = "CRLF"- show IO.LF = "LF"--instance Show IO.NewlineMode where- show (IO.NewlineMode i o) = "NewlineMode { inputNL = " ++ show i ++- ", outputNL = " ++ show o ++ " }"-# endif--instance Arbitrary IO.NewlineMode where- arbitrary = oneof . map return $- [ IO.noNewlineTranslation, IO.universalNewlineMode, IO.nativeNewlineMode- , windowsNewlineMode- ]--instance Arbitrary IO.BufferMode where- arbitrary = oneof [ return IO.NoBuffering,- return IO.LineBuffering,- return (IO.BlockBuffering Nothing),- (IO.BlockBuffering . Just . (+1) . fromIntegral) `fmap`- (arbitrary :: Gen Word16) ]---- This test harness is complex! What property are we checking?------ Reading after writing a multi-line file should give the same--- results as were written.------ What do we vary while checking this property?--- * The lines themselves, scrubbed to contain neither CR nor LF. (By--- working with a list of lines, we ensure that the data will--- sometimes contain line endings.)--- * Encoding.--- * Newline translation mode.--- * Buffering.-write_read :: (NFData a, Eq a)- => ([b] -> a)- -> ((Char -> Bool) -> a -> b)- -> (IO.Handle -> a -> IO ())- -> (IO.Handle -> IO a)- -> Encoding- -> IO.NewlineMode- -> IO.BufferMode- -> [a]- -> Property-write_read unline filt writer reader (E _ _) nl buf ts =- monadicIO $ assert . (==t) =<< run act- where t = unline . map (filt (not . (`elem` "\r\n"))) $ ts- act = withTempFile $ \path h -> do- -- hSetEncoding h enc- IO.hSetNewlineMode h nl- IO.hSetBuffering h buf- () <- writer h t- IO.hClose h- bracket (IO.openFile path IO.ReadMode) IO.hClose $ \h' -> do- -- hSetEncoding h' enc- IO.hSetNewlineMode h' nl- IO.hSetBuffering h' buf- r <- reader h'- r `deepseq` return r
− tests/tests/src/Data/Text/Tests/Regressions.hs
@@ -1,57 +0,0 @@--- | Regression tests for specific bugs.----{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}-module Data.Text.Tests.Regressions- (- tests- ) where--import Control.Exception (SomeException, handle)-import System.IO-import Test.HUnit (assertFailure)-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as LB-import qualified Data.Text as T-import qualified Data.Text.IO as T-import qualified Data.Text.Lazy as LT-import qualified Data.Text.Lazy.Encoding as LE-import qualified Test.Framework as F-import qualified Test.Framework.Providers.HUnit as F--import Data.Text.Tests.Utils (withTempFile)---- Reported by Michael Snoyman: UTF-8 encoding a large lazy bytestring--- caused either a segfault or attempt to allocate a negative number--- of bytes.-lazy_encode_crash :: IO ()-lazy_encode_crash = withTempFile $ \ _ h ->- LB.hPut h . LE.encodeUtf8 . LT.pack . replicate 100000 $ 'a'---- Reported by Pieter Laeremans: attempting to read an incorrectly--- encoded file can result in a crash in the RTS (i.e. not merely an--- exception).-hGetContents_crash :: IO ()-hGetContents_crash = withTempFile $ \ path h -> do- B.hPut h (B.pack [0x78, 0xc4 ,0x0a]) >> hClose h- h' <- openFile path ReadMode- hSetEncoding h' utf8- handle (\(_::SomeException) -> return ()) $- T.hGetContents h' >> assertFailure "T.hGetContents should crash"---- Reported by Ian Lynagh: attempting to allocate a sufficiently large--- string (via either Array.new or Text.replicate) could result in an--- integer overflow.-replicate_crash :: IO ()-replicate_crash = handle (\(_::SomeException) -> return ()) $- T.replicate (2^power) "0123456789abcdef" `seq`- assertFailure "T.replicate should crash"- where- power | maxBound == (2147483647::Int) = 28- | otherwise = 60 :: Int--tests :: F.Test-tests = F.testGroup "Regressions"- [ F.testCase "hGetContents_crash" hGetContents_crash- , F.testCase "lazy_encode_crash" lazy_encode_crash- , F.testCase "replicate_crash" replicate_crash- ]
− tests/tests/src/Data/Text/Tests/SlowFunctions.hs
@@ -1,39 +0,0 @@-{-# LANGUAGE BangPatterns #-}-module Data.Text.Tests.SlowFunctions- (- indices- , splitOn- ) where--import qualified Data.Text as T-import Data.Text.Internal (Text(..))-import Data.Text.Unsafe (iter_, unsafeHead, unsafeTail)--indices :: T.Text -- ^ Substring to search for (@needle@)- -> T.Text -- ^ Text to search in (@haystack@)- -> [Int]-indices needle@(Text _narr _noff nlen) haystack@(Text harr hoff hlen)- | T.null needle = []- | otherwise = scan 0- where- scan i | i >= hlen = []- | needle `T.isPrefixOf` t = i : scan (i+nlen)- | otherwise = scan (i+d)- where t = Text harr (hoff+i) (hlen-i)- d = iter_ haystack i--splitOn :: T.Text -- ^ Text to split on- -> T.Text -- ^ Input text- -> [T.Text]-splitOn pat src0- | T.null pat = error "splitOn: empty"- | l == 1 = T.split (== (unsafeHead pat)) src0- | otherwise = go src0- where- l = T.length pat- go src = search 0 src- where- search !n !s- | T.null s = [src] -- not found- | pat `T.isPrefixOf` s = T.take n src : go (T.drop l s)- | otherwise = search (n+1) (unsafeTail s)
− tests/tests/src/Data/Text/Tests/Utils.hs
@@ -1,52 +0,0 @@--- | Miscellaneous testing utilities----{-# LANGUAGE ScopedTypeVariables #-}-module Data.Text.Tests.Utils- (- (=^=)- , withRedirect- , withTempFile- ) where--import Control.Exception (SomeException, bracket, bracket_, evaluate, try)-import Control.Monad (when)-import Debug.Trace (trace)-import GHC.IO.Handle.Internals (withHandle)-import System.Directory (removeFile)-import System.IO (Handle, hClose, hFlush, hIsOpen, hIsWritable, openTempFile)-import System.IO.Unsafe (unsafePerformIO)---- Ensure that two potentially bottom values (in the sense of crashing--- for some inputs, not looping infinitely) either both crash, or both--- give comparable results for some input.-(=^=) :: (Eq a, Show a) => a -> a -> Bool-i =^= j = unsafePerformIO $ do- x <- try (evaluate i)- y <- try (evaluate j)- case (x,y) of- (Left (_ :: SomeException), Left (_ :: SomeException))- -> return True- (Right a, Right b) -> return (a == b)- e -> trace ("*** Divergence: " ++ show e) return False-infix 4 =^=-{-# NOINLINE (=^=) #-}--withTempFile :: (FilePath -> Handle -> IO a) -> IO a-withTempFile = bracket (openTempFile "." "crashy.txt") cleanupTemp . uncurry- where- cleanupTemp (path,h) = do- open <- hIsOpen h- when open (hClose h)- removeFile path--withRedirect :: Handle -> Handle -> IO a -> IO a-withRedirect tmp h = bracket_ swap swap- where- whenM p a = p >>= (`when` a)- swap = do- whenM (hIsOpen tmp) $ whenM (hIsWritable tmp) $ hFlush tmp- whenM (hIsOpen h) $ whenM (hIsWritable h) $ hFlush h- withHandle "spam" tmp $ \tmph -> do- hh <- withHandle "spam" h $ \hh ->- return (tmph,hh)- return (hh,())
− tests/tests/text-tests.cabal
@@ -1,124 +0,0 @@-name: text-tests-version: 0.0.0.0-synopsis: Functional tests for the text package-description: Functional tests for the text package-homepage: https://bitbucket.org/bos/text-license: BSD3-license-file: ../../LICENSE-author: Jasper Van der Jeugt <jaspervdj@gmail.com>,- Bryan O'Sullivan <bos@serpentine.com>,- Tom Harper <rtomharper@googlemail.com>,- Duncan Coutts <duncan@haskell.org>-maintainer: Bryan O'Sullivan <bos@serpentine.com>-category: Text-build-type: Simple--cabal-version: >=1.8--flag hpc- description: Enable HPC to generate coverage reports- default: False--executable text-tests- hs-source-dirs: src- main-is: Data/Text/Tests.hs-- ghc-options:- -Wall -threaded -O0 -rtsopts-- if flag(hpc)- ghc-options:- -fhpc-- cpp-options:- -DASSERTS- -DHAVE_DEEPSEQ-- build-depends:- text-tests,- base >= 4 && < 5,- bytestring >= 0.9,- deepseq >= 1.1,- directory >= 1.1 && < 1.2,- random >= 1.0 && < 1.1,- QuickCheck >= 2.4 && < 2.5,- HUnit >= 1.2 && < 1.3,- test-framework >= 0.4 && < 0.5,- test-framework-quickcheck2 >= 0.2 && < 0.3,- test-framework-hunit >= 0.2 && < 0.3--executable text-tests-stdio- hs-source-dirs: src- main-is: Data/Text/Tests/IO.hs-- ghc-options:- -Wall -threaded -rtsopts-- -- Optional HPC support- if flag(hpc)- ghc-options:- -fhpc-- build-depends:- text-tests,- base >= 4 && < 5--library- hs-source-dirs: ../..- c-sources: ../../cbits/cbits.c- exposed-modules:- Data.Text- Data.Text.Array- Data.Text.Encoding- Data.Text.Encoding.Error- Data.Text.Foreign- Data.Text.IO- Data.Text.Internal- Data.Text.Lazy- Data.Text.Lazy.Builder- Data.Text.Lazy.Builder.Int- Data.Text.Lazy.Builder.RealFloat- Data.Text.Lazy.Encoding- Data.Text.Lazy.IO- Data.Text.Lazy.Internal- Data.Text.Lazy.Read- Data.Text.Read- Data.Text.Encoding.Fusion- Data.Text.Encoding.Fusion.Common- Data.Text.Encoding.Utf16- Data.Text.Encoding.Utf32- Data.Text.Encoding.Utf8- Data.Text.Fusion- Data.Text.Fusion.CaseMapping- Data.Text.Fusion.Common- Data.Text.Fusion.Internal- Data.Text.Fusion.Size- Data.Text.IO.Internal- Data.Text.Lazy.Builder.Functions- Data.Text.Lazy.Builder.RealFloat.Functions- Data.Text.Lazy.Encoding.Fusion- Data.Text.Lazy.Fusion- Data.Text.Lazy.Search- Data.Text.Search- Data.Text.Unsafe- Data.Text.Unsafe.Base- Data.Text.UnsafeChar- Data.Text.UnsafeShift- Data.Text.Util-- if flag(hpc)- ghc-options:- -fhpc-- cpp-options:- -DHAVE_DEEPSEQ- -DASSERTS- -DINTEGER_GMP-- build-depends:- array,- base >= 4 && < 5,- bytestring >= 0.9,- deepseq >= 1.1,- integer-gmp >= 0.2 && < 0.3,- ghc-prim >= 0.2 && < 0.3
+ tests/text-tests.cabal view
@@ -0,0 +1,123 @@+name: text-tests+version: 0.0.0.0+synopsis: Functional tests for the text package+description: Functional tests for the text package+homepage: https://bitbucket.org/bos/text+license: BSD3+license-file: ../LICENSE+author: Jasper Van der Jeugt <jaspervdj@gmail.com>,+ Bryan O'Sullivan <bos@serpentine.com>,+ Tom Harper <rtomharper@googlemail.com>,+ Duncan Coutts <duncan@haskell.org>+maintainer: Bryan O'Sullivan <bos@serpentine.com>+category: Text+build-type: Simple++cabal-version: >=1.8++flag hpc+ description: Enable HPC to generate coverage reports+ default: False++executable text-tests+ main-is: Tests.hs++ ghc-options:+ -Wall -threaded -O0 -rtsopts++ if flag(hpc)+ ghc-options:+ -fhpc++ cpp-options:+ -DASSERTS+ -DHAVE_DEEPSEQ++ build-depends:+ HUnit >= 1.2,+ QuickCheck >= 2.4,+ base == 4.*,+ bytestring,+ deepseq,+ directory,+ random,+ test-framework >= 0.4,+ test-framework-hunit >= 0.2,+ test-framework-quickcheck2 >= 0.2,+ text-tests++executable text-tests-stdio+ main-is: Tests/IO.hs++ ghc-options:+ -Wall -threaded -rtsopts++ -- Optional HPC support+ if flag(hpc)+ ghc-options:+ -fhpc++ build-depends:+ text-tests,+ base >= 4 && < 5++library+ hs-source-dirs: ..+ c-sources: ../cbits/cbits.c+ exposed-modules:+ Data.Text+ Data.Text.Array+ Data.Text.Encoding+ Data.Text.Encoding.Error+ Data.Text.Encoding.Fusion+ Data.Text.Encoding.Fusion.Common+ Data.Text.Encoding.Utf16+ Data.Text.Encoding.Utf32+ Data.Text.Encoding.Utf8+ Data.Text.Foreign+ Data.Text.Fusion+ Data.Text.Fusion.CaseMapping+ Data.Text.Fusion.Common+ Data.Text.Fusion.Internal+ Data.Text.Fusion.Size+ Data.Text.IO+ Data.Text.IO.Internal+ Data.Text.Internal+ Data.Text.Lazy+ Data.Text.Lazy.Builder+ Data.Text.Lazy.Builder.Functions+ Data.Text.Lazy.Builder.Int+ Data.Text.Lazy.Builder.RealFloat+ Data.Text.Lazy.Builder.RealFloat.Functions+ Data.Text.Lazy.Encoding+ Data.Text.Lazy.Encoding.Fusion+ Data.Text.Lazy.Fusion+ Data.Text.Lazy.IO+ Data.Text.Lazy.Internal+ Data.Text.Lazy.Read+ Data.Text.Lazy.Search+ Data.Text.Private+ Data.Text.Read+ Data.Text.Search+ Data.Text.Unsafe+ Data.Text.Unsafe.Base+ Data.Text.UnsafeChar+ Data.Text.UnsafeShift+ Data.Text.Util++ if flag(hpc)+ ghc-options:+ -fhpc++ cpp-options:+ -DHAVE_DEEPSEQ+ -DASSERTS+ -DINTEGER_GMP++ build-depends:+ array,+ base == 4.*,+ bytestring,+ deepseq,+ ghc-prim,+ integer-gmp
text.cabal view
@@ -1,9 +1,9 @@ name: text-version: 0.11.2.2+version: 0.11.2.3 homepage: https://github.com/bos/text bug-reports: https://github.com/bos/text/issues synopsis: An efficient packed Unicode text type.-description: +description: . An efficient packed, immutable Unicode text type (both strict and lazy), with a powerful loop fusion optimization framework.@@ -49,24 +49,24 @@ build-type: Simple cabal-version: >= 1.8 extra-source-files:- README.markdown -- scripts/CaseFolding.txt -- scripts/SpecialCasing.txt+ README.markdown+ benchmarks/Setup.hs+ benchmarks/cbits/*.c+ benchmarks/haskell/*.hs+ benchmarks/haskell/Benchmarks/*.hs+ benchmarks/python/*.py+ benchmarks/ruby/*.rb+ benchmarks/text-benchmarks.cabal scripts/*.hs- tests/README.markdown- tests/benchmarks/Setup.hs- tests/benchmarks/cbits/*.c- tests/benchmarks/python/*.py- tests/benchmarks/ruby/*.rb- tests/benchmarks/src/Data/Text/*.hs- tests/benchmarks/src/Data/Text/Benchmarks/*.hs- tests/benchmarks/text-benchmarks.cabal- tests/tests/.ghci- tests/tests/Makefile- tests/tests/scripts/*.sh- tests/tests/src/Data/Text/*.hs- tests/tests/src/Data/Text/Tests/*.hs- tests/tests/text-tests.cabal+ tests-and-benchmarks.markdown+ tests/*.hs+ tests/.ghci+ tests/Makefile+ tests/Tests/*.hs+ tests/scripts/*.sh+ tests/text-tests.cabal flag developer description: operate in developer mode@@ -147,18 +147,18 @@ build-depends: integer-simple >= 0.1 && < 0.5 else cpp-options: -DINTEGER_GMP- build-depends: integer-gmp >= 0.2 && < 0.5- + build-depends: integer-gmp >= 0.2 + if impl(ghc >= 6.9) && impl(ghc < 6.11) cpp-options: -DINTEGER_GMP build-depends: integer >= 0.1 && < 0.2 test-suite tests type: exitcode-stdio-1.0- hs-source-dirs: . tests/tests/src- main-is: Data/Text/Tests.hs- c-sources: cbits/cbits.c+ hs-source-dirs: tests+ main-is: Tests.hs+ -- c-sources: cbits/cbits.c ghc-options: -Wall -threaded -O0 -rtsopts@@ -167,18 +167,18 @@ -DASSERTS -DHAVE_DEEPSEQ build-depends:- base >= 4 && < 5,- bytestring >= 0.9,- deepseq >= 1.1,- ghc-prim,- directory >= 1.0 && < 1.2,+ HUnit >= 1.2,+ QuickCheck >= 2.4,+ base,+ bytestring,+ deepseq,+ directory, ghc-prim,- random >= 1.0 && < 1.1,- QuickCheck >= 2.4 && < 2.5,- HUnit >= 1.2 && < 1.3,- test-framework >= 0.4 && < 0.7,- test-framework-quickcheck2 >= 0.2 && < 0.3,- test-framework-hunit >= 0.2 && < 0.3+ random,+ test-framework >= 0.4,+ test-framework-hunit >= 0.2,+ test-framework-quickcheck2 >= 0.2,+ text source-repository head type: git