bytestring 0.11.0.0 → 0.11.1.0
raw patch · 33 files changed
+5994/−635 lines, 33 filesdep +bytestringdep +dlistdep +ghc-byteorderdep ~basedep ~deepseqdep ~ghc-primPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: bytestring, dlist, ghc-byteorder, random, tasty, tasty-bench, tasty-hunit, tasty-quickcheck, transformers
Dependency ranges changed: base, deepseq, ghc-prim
API changes (from Hackage documentation)
+ Data.ByteString: dropEnd :: Int -> ByteString -> ByteString
+ Data.ByteString: packZipWith :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString -> ByteString
+ Data.ByteString: takeEnd :: Int -> ByteString -> ByteString
+ Data.ByteString.Builder: instance GHC.Show.Show Data.ByteString.Builder.Internal.Builder
+ Data.ByteString.Builder.Prim.Internal: caseWordSize_32_64 :: a -> a -> a
+ Data.ByteString.Char8: dropEnd :: Int -> ByteString -> ByteString
+ Data.ByteString.Char8: findIndexEnd :: (Char -> Bool) -> ByteString -> Maybe Int
+ Data.ByteString.Char8: packZipWith :: (Char -> Char -> Char) -> ByteString -> ByteString -> ByteString
+ Data.ByteString.Char8: takeEnd :: Int -> ByteString -> ByteString
+ Data.ByteString.Internal: findIndexOrLength :: (Word8 -> Bool) -> ByteString -> Int
+ Data.ByteString.Internal: unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b
+ Data.ByteString.Lazy: compareLength :: ByteString -> Int64 -> Ordering
+ Data.ByteString.Lazy: packZipWith :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString -> ByteString
+ Data.ByteString.Lazy.Char8: compareLength :: ByteString -> Int64 -> Ordering
+ Data.ByteString.Lazy.Char8: elemIndexEnd :: Char -> ByteString -> Maybe Int64
+ Data.ByteString.Lazy.Char8: findIndexEnd :: (Char -> Bool) -> ByteString -> Maybe Int64
+ Data.ByteString.Lazy.Char8: packZipWith :: (Char -> Char -> Char) -> ByteString -> ByteString -> ByteString
+ Data.ByteString.Lazy.Char8: unzip :: [(Char, Char)] -> (ByteString, ByteString)
+ Data.ByteString.Short: SBS :: ByteArray# -> ShortByteString
- Data.ByteString.Internal: plusForeignPtr :: () => ForeignPtr a -> Int -> ForeignPtr b
+ Data.ByteString.Internal: plusForeignPtr :: ForeignPtr a -> Int -> ForeignPtr b
Files
- Changelog.md +24/−1
- Data/ByteString.hs +172/−158
- Data/ByteString/Builder.hs +8/−13
- Data/ByteString/Builder/ASCII.hs +4/−10
- Data/ByteString/Builder/Internal.hs +17/−37
- Data/ByteString/Builder/Prim.hs +15/−16
- Data/ByteString/Builder/Prim/ASCII.hs +3/−6
- Data/ByteString/Builder/Prim/Binary.hs +47/−50
- Data/ByteString/Builder/Prim/Internal.hs +22/−8
- Data/ByteString/Builder/Prim/Internal/Floating.hs +2/−2
- Data/ByteString/Builder/Prim/Internal/UncheckedShifts.hs +0/−107
- Data/ByteString/Char8.hs +46/−17
- Data/ByteString/Internal.hs +116/−51
- Data/ByteString/Lazy.hs +107/−72
- Data/ByteString/Lazy/Char8.hs +62/−38
- Data/ByteString/Lazy/Internal.hs +24/−8
- Data/ByteString/Short.hs +1/−1
- Data/ByteString/Short/Internal.hs +29/−34
- README.md +1/−1
- bench/BenchAll.hs +453/−0
- bench/BenchBoundsCheckFusion.hs +105/−0
- bench/BenchCSV.hs +547/−0
- bench/BenchIndices.hs +83/−0
- bytestring.cabal +60/−4
- cbits/fpstring.c +19/−1
- tests/LazyHClose.hs +64/−0
- tests/Properties.hs +2556/−0
- tests/QuickCheckUtils.hs +197/−0
- tests/Rules.hs +41/−0
- tests/builder/Data/ByteString/Builder/Prim/TestUtils.hs +364/−0
- tests/builder/Data/ByteString/Builder/Prim/Tests.hs +174/−0
- tests/builder/Data/ByteString/Builder/Tests.hs +614/−0
- tests/builder/TestSuite.hs +17/−0
Changelog.md view
@@ -1,8 +1,31 @@+[0.11.1.0] — February 2021++* [Add `Data.ByteString.Char8.findIndexEnd` and `Data.ByteString.Lazy.Char8.{elemIndexEnd,findIndexEnd,unzip}`](https://github.com/haskell/bytestring/pull/342)+* [Expose `ShortByteString` constructor from `Data.ByteString.Short`](https://github.com/haskell/bytestring/pull/313)+* [Add `compareLength` function, which is lazier than comparison of lengths](https://github.com/haskell/bytestring/pull/300)+* [Add strict `takeEnd` and `dropEnd`](https://github.com/haskell/bytestring/pull/290)+* [Expose `packZipWith` to zip two `ByteString`](https://github.com/haskell/bytestring/pull/295)+* [Add `instance Show Builder`](https://github.com/haskell/bytestring/pull/296)+* [Improve lazy `pack` to carry fewer arguments in the inner loop](https://github.com/haskell/bytestring/pull/292)+* [Improve `map`, `findIndex` and `findIndexEnd` to carry fewer arguments in the inner loop](https://github.com/haskell/bytestring/pull/347)+* [Improve lazy `{take,drop}While`, `break` and `group{,By}` to carry fewer arguments in the inner loop](https://github.com/haskell/bytestring/pull/337)+* [Speed up `intersperse` using SSE2 instructions](https://github.com/haskell/bytestring/pull/310)+* [`fromShort` does not reallocate its argument, if it is pinned](https://github.com/haskell/bytestring/pull/317)+* [Speed up `words` using a faster test for spaces](https://github.com/haskell/bytestring/pull/315)+* [Implement `stimes` more efficiently than default definition](https://github.com/haskell/bytestring/pull/301)++[0.11.1.0]: https://github.com/haskell/bytestring/compare/0.11.0.0...0.11.1.0++[0.10.12.1] – January 2021++* [Replace `withForeignPtr` with `unsafeWithForeignPtr` where appropriate](https://github.com/haskell/bytestring/pull/333)++[0.10.12.1]: https://github.com/haskell/bytestring/compare/0.10.12.0...0.10.12.1+ [0.11.0.0] — September 2020 * [Change internal representation of `ByteString`, removing offset](https://github.com/haskell/bytestring/pull/175) * The old `PS` constructor has been turned into a pattern synonym that is available with GHC >= 8.0 for backwards compatibility. Consider adding `if !impl(ghc >=8.0) { build-depends: bytestring < 0.11 }` to packages, which use `PS` and still support GHC < 8.0. * [Fill `ForeignPtrContents` of `nullForeignPtr` with `FinalPtr` instead of a bottom](https://github.com/haskell/bytestring/pull/284)- * While `bytestring-0.11` is compatible with GHC >= 7.0, note that `bytestring < 0.11` will be unbuildable with GHC >= 9.0. * [Remove deprecated functions `findSubstring` and `findSubstrings`](https://github.com/haskell/bytestring/pull/181) * [Speed up sorting of short strings](https://github.com/haskell/bytestring/pull/267) * [Improve handling of literal strings in `Data.ByteString.Builder`](https://github.com/haskell/bytestring/pull/132)
Data/ByteString.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE TupleSections #-} {-# OPTIONS_HADDOCK prune #-} #if __GLASGOW_HASKELL__ >= 701 {-# LANGUAGE Trustworthy #-}@@ -112,7 +113,9 @@ -- ** Breaking strings take, -- :: Int -> ByteString -> ByteString+ takeEnd, -- :: Int -> ByteString -> ByteString drop, -- :: Int -> ByteString -> ByteString+ dropEnd, -- :: Int -> ByteString -> ByteString splitAt, -- :: Int -> ByteString -> (ByteString, ByteString) takeWhile, -- :: (Word8 -> Bool) -> ByteString -> ByteString takeWhileEnd, -- :: (Word8 -> Bool) -> ByteString -> ByteString@@ -167,6 +170,7 @@ -- * Zipping and unzipping ByteStrings zip, -- :: ByteString -> ByteString -> [(Word8,Word8)] zipWith, -- :: (Word8 -> Word8 -> c) -> ByteString -> ByteString -> [c]+ packZipWith, -- :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString -> ByteString unzip, -- :: [(Word8,Word8)] -> (ByteString,ByteString) -- * Ordered ByteStrings@@ -238,7 +242,7 @@ import Data.Word (Word8) import Control.Exception (IOException, catch, finally, assert, throwIO)-import Control.Monad (when)+import Control.Monad (when, void) import Foreign.C.String (CString, CStringLen) import Foreign.C.Types (CSize)@@ -257,19 +261,14 @@ import System.IO (stdin,stdout,hClose,hFileSize ,hGetBuf,hPutBuf,hGetBufNonBlocking ,hPutBufNonBlocking,withBinaryFile- ,IOMode(..))+ ,IOMode(..),hGetBufSome) import System.IO.Error (mkIOError, illegalOperationErrorType) #if !(MIN_VERSION_base(4,8,0))+import Control.Applicative ((<$>)) import Data.Monoid (Monoid(..)) #endif -#if MIN_VERSION_base(4,3,0)-import System.IO (hGetBufSome)-#else-import System.IO (hWaitForInput, hIsEOF)-#endif- import Data.IORef import GHC.IO.Handle.Internals import GHC.IO.Handle.Types@@ -365,14 +364,14 @@ -- | /O(n)/ 'cons' is analogous to (:) for lists, but of different -- complexity, as it requires making a copy. cons :: Word8 -> ByteString -> ByteString-cons c (BS x l) = unsafeCreate (l+1) $ \p -> withForeignPtr x $ \f -> do+cons c (BS x l) = unsafeCreate (l+1) $ \p -> unsafeWithForeignPtr x $ \f -> do poke p c memcpy (p `plusPtr` 1) f (fromIntegral l) {-# INLINE cons #-} -- | /O(n)/ Append a byte to the end of a 'ByteString' snoc :: ByteString -> Word8 -> ByteString-snoc (BS x l) c = unsafeCreate (l+1) $ \p -> withForeignPtr x $ \f -> do+snoc (BS x l) c = unsafeCreate (l+1) $ \p -> unsafeWithForeignPtr x $ \f -> do memcpy p f (fromIntegral l) poke (p `plusPtr` l) c {-# INLINE snoc #-}@@ -384,7 +383,7 @@ head :: ByteString -> Word8 head (BS x l) | l <= 0 = errorEmptyList "head"- | otherwise = accursedUnutterablePerformIO $ withForeignPtr x $ \p -> peek p+ | otherwise = accursedUnutterablePerformIO $ unsafeWithForeignPtr x $ \p -> peek p {-# INLINE head #-} -- | /O(1)/ Extract the elements after the head of a ByteString, which must be non-empty.@@ -400,7 +399,7 @@ uncons :: ByteString -> Maybe (Word8, ByteString) uncons (BS x l) | l <= 0 = Nothing- | otherwise = Just (accursedUnutterablePerformIO $ withForeignPtr x+ | otherwise = Just (accursedUnutterablePerformIO $ unsafeWithForeignPtr x $ \p -> peek p, BS (plusForeignPtr x 1) (l-1)) {-# INLINE uncons #-}@@ -411,7 +410,7 @@ last ps@(BS x l) | null ps = errorEmptyList "last" | otherwise = accursedUnutterablePerformIO $- withForeignPtr x $ \p -> peekByteOff p (l-1)+ unsafeWithForeignPtr x $ \p -> peekByteOff p (l-1) {-# INLINE last #-} -- | /O(1)/ Return all the elements of a 'ByteString' except the last one.@@ -429,7 +428,7 @@ | l <= 0 = Nothing | otherwise = Just (BS x (l-1), accursedUnutterablePerformIO $- withForeignPtr x $ \p -> peekByteOff p (l-1))+ unsafeWithForeignPtr x $ \p -> peekByteOff p (l-1)) {-# INLINE unsnoc #-} -- | /O(n)/ Append two ByteStrings@@ -443,21 +442,23 @@ -- | /O(n)/ 'map' @f xs@ is the ByteString obtained by applying @f@ to each -- element of @xs@. map :: (Word8 -> Word8) -> ByteString -> ByteString-map f (BS fp len) = unsafeDupablePerformIO $ withForeignPtr fp $ \a ->- create len $ map_ 0 a+map f (BS fp len) = unsafeDupablePerformIO $ unsafeWithForeignPtr fp $ \srcPtr ->+ create len $ \dstPtr -> m srcPtr dstPtr where- map_ :: Int -> Ptr Word8 -> Ptr Word8 -> IO ()- map_ !n !p1 !p2- | n >= len = return ()- | otherwise = do- x <- peekByteOff p1 n- pokeByteOff p2 n (f x)- map_ (n+1) p1 p2+ m !p1 !p2 = map_ 0+ where+ map_ :: Int -> IO ()+ map_ !n+ | n >= len = return ()+ | otherwise = do+ x <- peekByteOff p1 n+ pokeByteOff p2 n (f x)+ map_ (n+1) {-# INLINE map #-} -- | /O(n)/ 'reverse' @xs@ efficiently returns the elements of @xs@ in reverse order. reverse :: ByteString -> ByteString-reverse (BS x l) = unsafeCreate l $ \p -> withForeignPtr x $ \f ->+reverse (BS x l) = unsafeCreate l $ \p -> unsafeWithForeignPtr x $ \f -> c_reverse p f (fromIntegral l) -- | /O(n)/ The 'intersperse' function takes a 'Word8' and a@@ -467,13 +468,13 @@ intersperse :: Word8 -> ByteString -> ByteString intersperse c ps@(BS x l) | length ps < 2 = ps- | otherwise = unsafeCreate (2*l-1) $ \p -> withForeignPtr x $ \f ->+ | otherwise = unsafeCreate (2*l-1) $ \p -> unsafeWithForeignPtr x $ \f -> c_intersperse p f (fromIntegral l) c -- | The 'transpose' function transposes the rows and columns of its -- 'ByteString' argument. transpose :: [ByteString] -> [ByteString]-transpose ps = P.map pack . List.transpose . P.map unpack $ ps+transpose = P.map pack . List.transpose . P.map unpack -- --------------------------------------------------------------------- -- Reducing 'ByteString's@@ -485,7 +486,7 @@ foldl :: (a -> Word8 -> a) -> a -> ByteString -> a foldl f z (BS fp len) = go (end `plusPtr` len) where- end = (unsafeForeignPtrToPtr fp) `plusPtr` (-1)+ end = unsafeForeignPtrToPtr fp `plusPtr` (-1) -- not tail recursive; traverses array right to left go !p | p == end = z | otherwise = let !x = accursedUnutterablePerformIO $ do@@ -499,7 +500,7 @@ -- foldl' :: (a -> Word8 -> a) -> a -> ByteString -> a foldl' f v (BS fp len) =- accursedUnutterablePerformIO $ withForeignPtr fp g+ accursedUnutterablePerformIO $ unsafeWithForeignPtr fp g where g ptr = go v ptr where@@ -530,7 +531,7 @@ -- | 'foldr'' is like 'foldr', but strict in the accumulator. foldr' :: (Word8 -> a -> a) -> a -> ByteString -> a foldr' k v (BS fp len) =- accursedUnutterablePerformIO $ withForeignPtr fp g+ accursedUnutterablePerformIO $ unsafeWithForeignPtr fp g where g ptr = go v (end `plusPtr` len) where@@ -545,34 +546,34 @@ -- argument, and thus must be applied to non-empty 'ByteString's. -- An exception will be thrown in the case of an empty ByteString. foldl1 :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8-foldl1 f ps- | null ps = errorEmptyList "foldl1"- | otherwise = foldl f (unsafeHead ps) (unsafeTail ps)+foldl1 f ps = case uncons ps of+ Nothing -> errorEmptyList "foldl1"+ Just (h, t) -> foldl f h t {-# INLINE foldl1 #-} -- | 'foldl1'' is like 'foldl1', but strict in the accumulator. -- An exception will be thrown in the case of an empty ByteString. foldl1' :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8-foldl1' f ps- | null ps = errorEmptyList "foldl1'"- | otherwise = foldl' f (unsafeHead ps) (unsafeTail ps)+foldl1' f ps = case uncons ps of+ Nothing -> errorEmptyList "foldl1'"+ Just (h, t) -> foldl' f h t {-# INLINE foldl1' #-} -- | 'foldr1' is a variant of 'foldr' that has no starting value argument, -- and thus must be applied to non-empty 'ByteString's -- An exception will be thrown in the case of an empty ByteString. foldr1 :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8-foldr1 f ps- | null ps = errorEmptyList "foldr1"- | otherwise = foldr f (unsafeLast ps) (unsafeInit ps)+foldr1 f ps = case unsnoc ps of+ Nothing -> errorEmptyList "foldr1"+ Just (b, c) -> foldr f c b {-# INLINE foldr1 #-} -- | 'foldr1'' is a variant of 'foldr1', but is strict in the -- accumulator. foldr1' :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8-foldr1' f ps- | null ps = errorEmptyList "foldr1"- | otherwise = foldr' f (unsafeLast ps) (unsafeInit ps)+foldr1' f ps = case unsnoc ps of+ Nothing -> errorEmptyList "foldr1'"+ Just (b, c) -> foldr' f c b {-# INLINE foldr1' #-} -- ---------------------------------------------------------------------@@ -592,7 +593,7 @@ -- any element of the 'ByteString' satisfies the predicate. any :: (Word8 -> Bool) -> ByteString -> Bool any _ (BS _ 0) = False-any f (BS x len) = accursedUnutterablePerformIO $ withForeignPtr x g+any f (BS x len) = accursedUnutterablePerformIO $ unsafeWithForeignPtr x g where g ptr = go ptr where@@ -621,7 +622,7 @@ -- | Is any element of 'ByteString' equal to c? anyByte :: Word8 -> ByteString -> Bool-anyByte c (BS x l) = accursedUnutterablePerformIO $ withForeignPtr x $ \p -> do+anyByte c (BS x l) = accursedUnutterablePerformIO $ unsafeWithForeignPtr x $ \p -> do q <- memchr p c (fromIntegral l) return $! q /= nullPtr {-# INLINE anyByte #-}@@ -632,7 +633,7 @@ -- if all elements of the 'ByteString' satisfy the predicate. all :: (Word8 -> Bool) -> ByteString -> Bool all _ (BS _ 0) = True-all f (BS x len) = accursedUnutterablePerformIO $ withForeignPtr x g+all f (BS x len) = accursedUnutterablePerformIO $ unsafeWithForeignPtr x g where g ptr = go ptr where@@ -668,7 +669,7 @@ maximum :: ByteString -> Word8 maximum xs@(BS x l) | null xs = errorEmptyList "maximum"- | otherwise = accursedUnutterablePerformIO $ withForeignPtr x $ \p ->+ | otherwise = accursedUnutterablePerformIO $ unsafeWithForeignPtr x $ \p -> c_maximum p (fromIntegral l) {-# INLINE maximum #-} @@ -678,7 +679,7 @@ minimum :: ByteString -> Word8 minimum xs@(BS x l) | null xs = errorEmptyList "minimum"- | otherwise = accursedUnutterablePerformIO $ withForeignPtr x $ \p ->+ | otherwise = accursedUnutterablePerformIO $ unsafeWithForeignPtr x $ \p -> c_minimum p (fromIntegral l) {-# INLINE minimum #-} @@ -689,9 +690,9 @@ -- passing an accumulating parameter from left to right, and returning a -- final value of this accumulator together with the new list. mapAccumL :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString)-mapAccumL f acc (BS fp len) = unsafeDupablePerformIO $ withForeignPtr fp $ \a -> do+mapAccumL f acc (BS fp len) = unsafeDupablePerformIO $ unsafeWithForeignPtr fp $ \a -> do gp <- mallocByteString len- acc' <- withForeignPtr gp (go a)+ acc' <- unsafeWithForeignPtr gp (go a) return (acc', BS gp len) where go src dst = mapAccumL_ acc 0@@ -710,10 +711,10 @@ -- passing an accumulating parameter from right to left, and returning a -- final value of this accumulator together with the new ByteString. mapAccumR :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString)-mapAccumR f acc (BS fp len) = unsafeDupablePerformIO $ withForeignPtr fp $ \a -> do+mapAccumR f acc (BS fp len) = unsafeDupablePerformIO $ unsafeWithForeignPtr fp $ \a -> do gp <- mallocByteString len- acc' <- withForeignPtr gp (go a)- return $! (acc', BS gp len)+ acc' <- unsafeWithForeignPtr gp (go a)+ return (acc', BS gp len) where go src dst = mapAccumR_ acc (len-1) where@@ -747,7 +748,7 @@ -- ^ input of length n -> ByteString -- ^ output of length n+1-scanl f v (BS fp len) = unsafeDupablePerformIO $ withForeignPtr fp $ \a ->+scanl f v (BS fp len) = unsafeDupablePerformIO $ unsafeWithForeignPtr fp $ \a -> create (len+1) $ \q -> do poke q v go a (q `plusPtr` 1)@@ -772,9 +773,9 @@ -- -- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...] scanl1 :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString-scanl1 f ps- | null ps = empty- | otherwise = scanl f (unsafeHead ps) (unsafeTail ps)+scanl1 f ps = case uncons ps of+ Nothing -> empty+ Just (h, t) -> scanl f h t {-# INLINE scanl1 #-} -- | 'scanr' is similar to 'foldr', but returns a list of successive@@ -796,7 +797,7 @@ -- ^ input of length n -> ByteString -- ^ output of length n+1-scanr f v (BS fp len) = unsafeDupablePerformIO $ withForeignPtr fp $ \a ->+scanr f v (BS fp len) = unsafeDupablePerformIO $ unsafeWithForeignPtr fp $ \a -> create (len+1) $ \q -> do poke (q `plusPtr` len) v go a q@@ -814,9 +815,9 @@ -- | 'scanr1' is a variant of 'scanr' that has no starting value argument. scanr1 :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString-scanr1 f ps- | null ps = empty- | otherwise = scanr f (unsafeLast ps) (unsafeInit ps)+scanr1 f ps = case unsnoc ps of+ Nothing -> empty+ Just (b, c) -> scanr f c b {-# INLINE scanr1 #-} -- ---------------------------------------------------------------------@@ -832,7 +833,7 @@ replicate w c | w <= 0 = empty | otherwise = unsafeCreate w $ \ptr ->- memset ptr c (fromIntegral w) >> return ()+ void $ memset ptr c (fromIntegral w) {-# INLINE replicate #-} -- | /O(n)/, where /n/ is the length of the result. The 'unfoldr'@@ -851,7 +852,7 @@ unfoldr f = concat . unfoldChunk 32 64 where unfoldChunk n n' x = case unfoldrN n f x of- (s, Nothing) -> s : []+ (s, Nothing) -> [s] (s, Just x') -> s : unfoldChunk n' (n+n') x' {-# INLINE unfoldr #-} @@ -889,6 +890,24 @@ | otherwise = BS x n {-# INLINE take #-} +-- | /O(1)/ @'takeEnd' n xs@ is equivalent to @'drop' ('length' xs - n) xs@.+-- Takes @n@ elements from end of bytestring.+--+-- >>> takeEnd 3 "abcdefg"+-- "efg"+-- >>> takeEnd 0 "abcdefg"+-- ""+-- >>> takeEnd 4 "abc"+-- "abc"+--+-- @since 0.11.1.0+takeEnd :: Int -> ByteString -> ByteString+takeEnd n ps@(BS x len)+ | n >= len = ps+ | n <= 0 = empty+ | otherwise = BS (plusForeignPtr x (len - n)) n+{-# INLINE takeEnd #-}+ -- | /O(1)/ 'drop' @n xs@ returns the suffix of @xs@ after the first @n@ -- elements, or @[]@ if @n > 'length' xs@. drop :: Int -> ByteString -> ByteString@@ -898,6 +917,24 @@ | otherwise = BS (plusForeignPtr x n) (l-n) {-# INLINE drop #-} +-- | /O(1)/ @'dropEnd' n xs@ is equivalent to @'take' ('length' xs - n) xs@.+-- Drops @n@ elements from end of bytestring.+--+-- >>> dropEnd 3 "abcdefg"+-- "abcd"+-- >>> dropEnd 0 "abcdefg"+-- "abcdefg"+-- >>> dropEnd 4 "abc"+-- ""+--+-- @since 0.11.1.0+dropEnd :: Int -> ByteString -> ByteString+dropEnd n ps@(BS x len)+ | n <= 0 = ps+ | n >= len = empty+ | otherwise = BS x (len - n)+{-# INLINE dropEnd #-}+ -- | /O(1)/ 'splitAt' @n xs@ is equivalent to @('take' n xs, 'drop' n xs)@. splitAt :: Int -> ByteString -> (ByteString, ByteString) splitAt n ps@(BS x l)@@ -910,7 +947,7 @@ -- returns the longest (possibly empty) prefix of elements -- satisfying the predicate. takeWhile :: (Word8 -> Bool) -> ByteString -> ByteString-takeWhile f ps = unsafeTake (findIndexOrEnd (not . f) ps) ps+takeWhile f ps = unsafeTake (findIndexOrLength (not . f) ps) ps {-# INLINE [1] takeWhile #-} #if MIN_VERSION_base(4,9,0)@@ -951,7 +988,7 @@ -- drops the longest (possibly empty) prefix of elements -- satisfying the predicate and returns the remainder. dropWhile :: (Word8 -> Bool) -> ByteString -> ByteString-dropWhile f ps = unsafeDrop (findIndexOrEnd (not . f) ps) ps+dropWhile f ps = unsafeDrop (findIndexOrLength (not . f) ps) ps {-# INLINE [1] dropWhile #-} #if MIN_VERSION_base(4,9,0)@@ -989,8 +1026,6 @@ dropWhileEnd f ps = unsafeTake (findFromEndUntil (not . f) ps) ps {-# INLINE dropWhileEnd #-} --- instead of findIndexOrEnd, we could use memchr here.- -- | Similar to 'P.break', -- returns the longest (possibly empty) prefix of elements which __do not__ -- satisfy the predicate and the remainder of the string.@@ -1004,7 +1039,7 @@ -- > break (==x) = breakByte x -- break :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)-break p ps = case findIndexOrEnd p ps of n -> (unsafeTake n ps, unsafeDrop n ps)+break p ps = case findIndexOrLength p ps of n -> (unsafeTake n ps, unsafeDrop n ps) {-# INLINE [1] break #-} -- See bytestring #70@@ -1053,7 +1088,7 @@ -- 'span' @p@ is equivalent to @'break' (not . p)@ and to @('takeWhile' p &&& 'dropWhile' p)@. -- span :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)-span p ps = break (not . p) ps+span p = break (not . p) {-# INLINE [1] span #-} -- | 'spanByte' breaks its ByteString argument at the first@@ -1064,7 +1099,7 @@ -- spanByte :: Word8 -> ByteString -> (ByteString, ByteString) spanByte c ps@(BS x l) =- accursedUnutterablePerformIO $ withForeignPtr x g+ accursedUnutterablePerformIO $ unsafeWithForeignPtr x g where g p = go 0 where@@ -1123,7 +1158,7 @@ splitWith predicate (BS fp len) = splitWith0 0 len fp where splitWith0 !off' !len' !fp' = accursedUnutterablePerformIO $- withForeignPtr fp $ \p ->+ unsafeWithForeignPtr fp $ \p -> splitLoop p 0 off' len' fp' splitLoop :: Ptr Word8@@ -1164,7 +1199,7 @@ split w (BS x l) = loop 0 where loop !n =- let q = accursedUnutterablePerformIO $ withForeignPtr x $ \p ->+ let q = accursedUnutterablePerformIO $ unsafeWithForeignPtr x $ \p -> memchr (p `plusPtr` n) w (fromIntegral (l-n)) in if q == nullPtr@@ -1187,19 +1222,19 @@ -- supply their own equality test. It is about 40% faster than -- /groupBy (==)/ group :: ByteString -> [ByteString]-group xs- | null xs = []- | otherwise = ys : group zs+group xs = case uncons xs of+ Nothing -> []+ Just (h, _) -> ys : group zs where- (ys, zs) = spanByte (unsafeHead xs) xs+ (ys, zs) = spanByte h xs -- | The 'groupBy' function is the non-overloaded version of 'group'. groupBy :: (Word8 -> Word8 -> Bool) -> ByteString -> [ByteString]-groupBy k xs- | null xs = []- | otherwise = unsafeTake n xs : groupBy k (unsafeDrop n xs)+groupBy k xs = case uncons xs of+ Nothing -> []+ Just (h, t) -> unsafeTake n xs : groupBy k (unsafeDrop n xs) where- n = 1 + findIndexOrEnd (not . k (unsafeHead xs)) (unsafeTail xs)+ n = 1 + findIndexOrLength (not . k h) t -- | /O(n)/ The 'intercalate' function takes a 'ByteString' and a list of -- 'ByteString's and concatenates the list after interspersing the first@@ -1218,8 +1253,8 @@ -- intercalateWithByte :: Word8 -> ByteString -> ByteString -> ByteString intercalateWithByte c f@(BS ffp l) g@(BS fgp m) = unsafeCreate len $ \ptr ->- withForeignPtr ffp $ \fp ->- withForeignPtr fgp $ \gp -> do+ unsafeWithForeignPtr ffp $ \fp ->+ unsafeWithForeignPtr fgp $ \gp -> do memcpy ptr fp (fromIntegral l) poke (ptr `plusPtr` l) c memcpy (ptr `plusPtr` (l + 1)) gp (fromIntegral m)@@ -1265,7 +1300,7 @@ -- element, or 'Nothing' if there is no such element. -- This implementation uses memchr(3). elemIndex :: Word8 -> ByteString -> Maybe Int-elemIndex c (BS x l) = accursedUnutterablePerformIO $ withForeignPtr x $ \p -> do+elemIndex c (BS x l) = accursedUnutterablePerformIO $ unsafeWithForeignPtr x $ \p -> do q <- memchr p c (fromIntegral l) return $! if q == nullPtr then Nothing else Just $! q `minusPtr` p {-# INLINE elemIndex #-}@@ -1275,8 +1310,9 @@ -- element, or 'Nothing' if there is no such element. The following -- holds: ----- > elemIndexEnd c xs ==--- > (-) (length xs - 1) `fmap` elemIndex c (reverse xs)+-- > elemIndexEnd c xs = case elemIndex c (reverse xs) of+-- > Nothing -> Nothing+-- > Just i -> Just (length xs - 1 - i) -- elemIndexEnd :: Word8 -> ByteString -> Maybe Int elemIndexEnd = findIndexEnd . (==)@@ -1288,7 +1324,7 @@ elemIndices :: Word8 -> ByteString -> [Int] elemIndices w (BS x l) = loop 0 where- loop !n = accursedUnutterablePerformIO $ withForeignPtr x $ \p -> do+ loop !n = accursedUnutterablePerformIO $ unsafeWithForeignPtr x $ \p -> do q <- memchr (p `plusPtr` n) w (fromIntegral (l - n)) if q == nullPtr then return []@@ -1302,21 +1338,23 @@ -- -- But more efficiently than using length on the intermediate list. count :: Word8 -> ByteString -> Int-count w (BS x m) = accursedUnutterablePerformIO $ withForeignPtr x $ \p ->- fmap fromIntegral $ c_count p (fromIntegral m) w+count w (BS x m) = accursedUnutterablePerformIO $ unsafeWithForeignPtr x $ \p ->+ fromIntegral <$> c_count p (fromIntegral m) w {-# INLINE count #-} -- | /O(n)/ The 'findIndex' function takes a predicate and a 'ByteString' and -- returns the index of the first element in the ByteString -- satisfying the predicate. findIndex :: (Word8 -> Bool) -> ByteString -> Maybe Int-findIndex k (BS x l) = accursedUnutterablePerformIO $ withForeignPtr x $ \f -> go f 0+findIndex k (BS x l) = accursedUnutterablePerformIO $ withForeignPtr x g where- go !ptr !n | n >= l = return Nothing- | otherwise = do w <- peek ptr- if k w- then return (Just n)- else go (ptr `plusPtr` 1) (n+1)+ g !ptr = go 0+ where+ go !n | n >= l = return Nothing+ | otherwise = do w <- peek $ ptr `plusPtr` n+ if k w+ then return (Just n)+ else go (n+1) {-# INLINE [1] findIndex #-} -- | /O(n)/ The 'findIndexEnd' function takes a predicate and a 'ByteString' and@@ -1325,19 +1363,21 @@ -- -- @since 0.10.12.0 findIndexEnd :: (Word8 -> Bool) -> ByteString -> Maybe Int-findIndexEnd k (BS x l) = accursedUnutterablePerformIO $ withForeignPtr x $ \ f -> go f (l-1)+findIndexEnd k (BS x l) = accursedUnutterablePerformIO $ withForeignPtr x g where- go !ptr !n | n < 0 = return Nothing- | otherwise = do w <- peekByteOff ptr n- if k w- then return (Just n)- else go ptr (n-1)+ g !ptr = go (l-1)+ where+ go !n | n < 0 = return Nothing+ | otherwise = do w <- peekByteOff ptr n+ if k w+ then return (Just n)+ else go (n-1) {-# INLINE findIndexEnd #-} -- | /O(n)/ The 'findIndices' function extends 'findIndex', by returning the -- indices of all elements satisfying the predicate, in ascending order. findIndices :: (Word8 -> Bool) -> ByteString -> [Int]-findIndices p ps = loop 0 ps+findIndices p = loop 0 where loop !n !qs = case findIndex p qs of Just !i ->@@ -1373,7 +1413,7 @@ -- | /O(n)/ 'notElem' is the inverse of 'elem' notElem :: Word8 -> ByteString -> Bool-notElem c ps = not (elem c ps)+notElem c ps = not (c `elem` ps) {-# INLINE notElem #-} -- | /O(n)/ 'filter', applied to a predicate and a ByteString,@@ -1479,7 +1519,7 @@ isPrefixOf (BS x1 l1) (BS x2 l2) | l1 == 0 = True | l2 < l1 = False- | otherwise = accursedUnutterablePerformIO $ withForeignPtr x1 $ \p1 ->+ | otherwise = accursedUnutterablePerformIO $ unsafeWithForeignPtr x1 $ \p1 -> withForeignPtr x2 $ \p2 -> do i <- memcmp p1 p2 (fromIntegral l1) return $! i == 0@@ -1507,7 +1547,7 @@ isSuffixOf (BS x1 l1) (BS x2 l2) | l1 == 0 = True | l2 < l1 = False- | otherwise = accursedUnutterablePerformIO $ withForeignPtr x1 $ \p1 ->+ | otherwise = accursedUnutterablePerformIO $ unsafeWithForeignPtr x1 $ \p1 -> withForeignPtr x2 $ \p2 -> do i <- memcmp p1 (p2 `plusPtr` (l2 - l1)) (fromIntegral l1) return $! i == 0@@ -1553,7 +1593,7 @@ -> (ByteString,ByteString) -- ^ Head and tail of string broken at substring breakSubstring pat = case lp of- 0 -> \src -> (empty,src)+ 0 -> (empty,) 1 -> breakByte (unsafeHead pat) _ -> if lp * 8 <= finiteBitSize (0 :: Word) then shift@@ -1608,28 +1648,30 @@ -- excess elements of the longer ByteString are discarded. This is -- equivalent to a pair of 'unpack' operations. zip :: ByteString -> ByteString -> [(Word8,Word8)]-zip ps qs- | null ps || null qs = []- | otherwise = (unsafeHead ps, unsafeHead qs) : zip (unsafeTail ps) (unsafeTail qs)+zip ps qs = case uncons ps of+ Nothing -> []+ Just (psH, psT) -> case uncons qs of+ Nothing -> []+ Just (qsH, qsT) -> (psH, qsH) : zip psT qsT -- | 'zipWith' generalises 'zip' by zipping with the function given as -- the first argument, instead of a tupling function. For example, -- @'zipWith' (+)@ is applied to two ByteStrings to produce the list of -- corresponding sums. zipWith :: (Word8 -> Word8 -> a) -> ByteString -> ByteString -> [a]-zipWith f ps qs- | null ps || null qs = []- | otherwise = f (unsafeHead ps) (unsafeHead qs) : zipWith f (unsafeTail ps) (unsafeTail qs)+zipWith f ps qs = case uncons ps of+ Nothing -> []+ Just (psH, psT) -> case uncons qs of+ Nothing -> []+ Just (qsH, qsT) -> f psH qsH : zipWith f psT qsT {-# NOINLINE [1] zipWith #-} ------ | A specialised version of zipWith for the common case of a--- simultaneous map over two bytestrings, to build a 3rd. Rewrite rules--- are used to automatically covert zipWith into zipWith' when a pack is--- performed on the result of zipWith.+-- | A specialised version of `zipWith` for the common case of a+-- simultaneous map over two ByteStrings, to build a 3rd. ---zipWith' :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString -> ByteString-zipWith' f (BS fp l) (BS fq m) = unsafeDupablePerformIO $+-- @since 0.11.1.0+packZipWith :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString -> ByteString+packZipWith f (BS fp l) (BS fq m) = unsafeDupablePerformIO $ withForeignPtr fp $ \a -> withForeignPtr fq $ \b -> create len $ go a b@@ -1646,11 +1688,11 @@ zipWith_ (n+1) r len = min l m-{-# INLINE zipWith' #-}+{-# INLINE packZipWith #-} {-# RULES "ByteString specialise zipWith" forall (f :: Word8 -> Word8 -> Word8) p q .- zipWith f p q = unpack (zipWith' f p q)+ zipWith f p q = unpack (packZipWith f p q) #-} -- | /O(n)/ 'unzip' transforms a list of pairs of bytes into a pair of@@ -1686,11 +1728,11 @@ | otherwise = unsafeCreate l $ \p -> allocaArray 256 $ \arr -> do _ <- memset (castPtr arr) 0 (256 * fromIntegral (sizeOf (undefined :: CSize)))- withForeignPtr input (\x -> countOccurrences arr x l)+ unsafeWithForeignPtr input (\x -> countOccurrences arr x l) let go 256 !_ = return () go i !ptr = do n <- peekElemOff arr i- when (n /= 0) $ memset ptr (fromIntegral i) n >> return ()+ when (n /= 0) $ void $ memset ptr (fromIntegral i) n go (i + 1) (ptr `plusPtr` fromIntegral n) go 0 p where@@ -1757,7 +1799,7 @@ -- is needed in the rest of the program. -- copy :: ByteString -> ByteString-copy (BS x l) = unsafeCreate l $ \p -> withForeignPtr x $ \f ->+copy (BS x l) = unsafeCreate l $ \p -> unsafeWithForeignPtr x $ \f -> memcpy p f (fromIntegral l) -- ---------------------------------------------------------------------@@ -1832,7 +1874,7 @@ -- | Outputs a 'ByteString' to the specified 'Handle'. hPut :: Handle -> ByteString -> IO () hPut _ (BS _ 0) = return ()-hPut h (BS ps l) = withForeignPtr ps $ \p-> hPutBuf h p l+hPut h (BS ps l) = unsafeWithForeignPtr ps $ \p-> hPutBuf h p l -- | Similar to 'hPut' except that it will never block. Instead it returns -- any tail that did not get written. This tail may be 'empty' in the case that@@ -1844,7 +1886,7 @@ -- hPutNonBlocking :: Handle -> ByteString -> IO ByteString hPutNonBlocking h bs@(BS ps l) = do- bytesWritten <- withForeignPtr ps $ \p-> hPutBufNonBlocking h p l+ bytesWritten <- unsafeWithForeignPtr ps $ \p-> hPutBufNonBlocking h p l return $! drop bytesWritten bs -- | A synonym for @hPut@, for compatibility@@ -1896,22 +1938,7 @@ -- hGetSome :: Handle -> Int -> IO ByteString hGetSome hh i-#if MIN_VERSION_base(4,3,0) | i > 0 = createAndTrim i $ \p -> hGetBufSome hh p i-#else- | i > 0 = let- loop = do- s <- hGetNonBlocking hh i- if not (null s)- then return s- else do eof <- hIsEOF hh- if eof then return s- else hWaitForInput hh (-1) >> loop- -- for this to work correctly, the- -- Handle should be in binary mode- -- (see GHC ticket #3808)- in loop-#endif | i == 0 = return empty | otherwise = illegalBufferSize hh "hGetSome" i @@ -1951,7 +1978,7 @@ where readChunks chunks sz sz' = do fp <- mallocByteString sz- readcount <- withForeignPtr fp $ \buf -> hGetBuf hnd buf sz+ readcount <- unsafeWithForeignPtr fp $ \buf -> hGetBuf hnd buf sz let chunk = BS fp readcount -- We rely on the hGetBuf behaviour (not hGetBufSome) where it reads up -- to the size we ask for, or EOF. So short reads indicate EOF.@@ -2007,21 +2034,6 @@ -- --------------------------------------------------------------------- -- Internal utilities --- | 'findIndexOrEnd' is a variant of findIndex, that returns the length--- of the string if no element is found, rather than Nothing.-findIndexOrEnd :: (Word8 -> Bool) -> ByteString -> Int-findIndexOrEnd k (BS x l) =- accursedUnutterablePerformIO $ withForeignPtr x g- where- g ptr = go 0- where- go !n | n >= l = return l- | otherwise = do w <- peek $ ptr `plusPtr` n- if k w- then return n- else go (n+1)-{-# INLINE findIndexOrEnd #-}- -- Common up near identical calls to `error' to reduce the number -- constant strings created when compiled: errorEmptyList :: String -> a@@ -2041,7 +2053,9 @@ -- Find from the end of the string using predicate findFromEndUntil :: (Word8 -> Bool) -> ByteString -> Int-findFromEndUntil f ps@(BS x l)- | null ps = 0- | f (unsafeLast ps) = l- | otherwise = findFromEndUntil f (BS x (l - 1))+findFromEndUntil f ps@(BS _ l) = case unsnoc ps of+ Nothing -> 0+ Just (b, c) ->+ if f c+ then l+ else findFromEndUntil f b
Data/ByteString/Builder.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, BangPatterns, MagicHash #-}+{-# LANGUAGE CPP, MagicHash #-} {-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-orphans #-} #if __GLASGOW_HASKELL__ >= 701 {-# LANGUAGE Trustworthy #-}@@ -58,8 +58,8 @@ import qualified "Data.ByteString.Lazy" as L import "Data.ByteString.Builder" import Data.Monoid-import Data.Foldable ('foldMap')-import Data.List ('intersperse')+import Data.Foldable ('Data.Foldable.foldMap')+import Data.List ('Data.List.intersperse') infixr 4 \<\> (\<\>) :: 'Monoid' m => m -> m -> m@@ -154,7 +154,7 @@ >renderRow :: Row -> Builder >renderRow = mconcat . intersperse (charUtf8 ',') . map renderCell -Similarly, using /O(n)/ concatentations like '++' or the equivalent 'S.concat'+Similarly, using /O(n)/ concatentations like '++' or the equivalent 'Data.ByteString.concat' operations on strict and lazy 'L.ByteString's should be avoided. The following definition of @renderString@ is also about 20% slower. @@ -266,15 +266,6 @@ import GHC.Base (unpackCString#, unpackCStringUtf8#, unpackFoldrCString#, build) --- HADDOCK only imports-import qualified Data.ByteString as S (concat)-#if !(MIN_VERSION_base(4,8,0))-import Data.Monoid (Monoid(..))-#endif-import Data.Foldable (foldMap)-import Data.List (intersperse)-- -- | Execute a 'Builder' and return the generated chunks as a lazy 'L.ByteString'. -- The work is performed lazy, i.e., only when a chunk of the lazy 'L.ByteString' -- is forced.@@ -478,3 +469,7 @@ instance IsString Builder where fromString = stringUtf8++-- | @since 0.11.1.0+instance Show Builder where+ show = show . toLazyByteString
Data/ByteString/Builder/ASCII.hs view
@@ -18,7 +18,7 @@ -- | Formatting of numbers as ASCII text. -- -- Note that you can also use these functions for the ISO/IEC 8859-1 and- -- UTF-8 encodings, as the ASCII encoding is equivalent on the + -- UTF-8 encodings, as the ASCII encoding is equivalent on the -- codepoints 0-127. -- *** Decimal numbers@@ -104,17 +104,11 @@ import GHC.Num (quotRemInteger) # endif -# if __GLASGOW_HASKELL__ < 611-import GHC.Integer.Internals-# else import GHC.Integer.GMP.Internals-# endif #endif #if HAS_INTEGER_CONSTR import qualified Data.ByteString.Builder.Prim.Internal as P-import Data.ByteString.Builder.Prim.Internal.UncheckedShifts- ( caseWordSize_32_64 ) import Foreign.C.Types import GHC.Types (Int(..)) #endif@@ -329,14 +323,14 @@ -- FIXME: Think about also using the MSB. For 64 bit 'Int's this makes a -- difference. maxPow10 :: Integer-maxPow10 = toInteger $ (10 :: Int) ^ caseWordSize_32_64 (9 :: Int) 18+maxPow10 = toInteger $ (10 :: Int) ^ P.caseWordSize_32_64 (9 :: Int) 18 -- | Decimal encoding of an 'Integer' using the ASCII digits. integerDec :: Integer -> Builder integerDec (IS i#) = intDec (I# i#) integerDec i | i < 0 = P.primFixed P.char8 '-' `mappend` go (-i)- | otherwise = go ( i)+ | otherwise = go i where errImpossible fun = error $ "integerDec: " ++ fun ++ ": the impossible happened."@@ -386,7 +380,7 @@ {-# INLINE intDecPadded #-} intDecPadded :: P.BoundedPrim Int-intDecPadded = P.liftFixedToBounded $ caseWordSize_32_64+intDecPadded = P.liftFixedToBounded $ P.caseWordSize_32_64 (P.fixedPrim 9 $ c_int_dec_padded9 . fromIntegral) (P.fixedPrim 18 $ c_long_long_int_dec_padded18 . fromIntegral)
Data/ByteString/Builder/Internal.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE ScopedTypeVariables, CPP, BangPatterns, RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables, CPP, BangPatterns, RankNTypes, TupleSections #-} #if __GLASGOW_HASKELL__ == 700 -- This is needed as a workaround for an old bug in GHC 7.0.1 (Trac #4498) {-# LANGUAGE MonoPatBinds #-}@@ -147,16 +147,11 @@ import qualified Data.ByteString.Lazy.Internal as L import qualified Data.ByteString.Short.Internal as Sh -#if __GLASGOW_HASKELL__ >= 611 import qualified GHC.IO.Buffer as IO (Buffer(..), newByteBuffer) import GHC.IO.Handle.Internals (wantWritableHandle, flushWriteBuffer) import GHC.IO.Handle.Types (Handle__, haByteBuffer, haBufferMode)-import System.IO (hFlush, BufferMode(..))+import System.IO (hFlush, BufferMode(..), Handle) import Data.IORef-#else-import qualified Data.ByteString.Lazy as L-#endif-import System.IO (Handle) #if MIN_VERSION_base(4,4,0) #if MIN_VERSION_base(4,7,0)@@ -316,7 +311,7 @@ -> BuildStep a -- ^ 'BuildStep' to run on next 'BufferRange' -> BuildSignal a-insertChunk op bs = InsertChunk op bs+insertChunk = InsertChunk -- | Fill a 'BufferRange' using a 'BuildStep'.@@ -374,7 +369,7 @@ -- | The final build step that returns the 'done' signal. finalBuildStep :: BuildStep ()-finalBuildStep !(BufferRange op _) = return $ Done op ()+finalBuildStep (BufferRange op _) = return $ Done op () -- | Run a 'Builder' with the 'finalBuildStep'. {-# INLINE runBuilder #-}@@ -394,7 +389,7 @@ -- only exported for use in rewriting rules. Use 'mempty' otherwise. {-# INLINE[1] empty #-} empty :: Builder-empty = Builder (\cont -> (\range -> cont range))+empty = Builder ($) -- This eta expansion (hopefully) allows GHC to worker-wrapper the -- 'BufferRange' in the 'empty' base case of loops (since -- worker-wrapper requires (TODO: verify this) that all paths match@@ -429,7 +424,7 @@ flush :: Builder flush = builder step where- step k !(BufferRange op _) = return $ insertChunk op S.empty k+ step k (BufferRange op _) = return $ insertChunk op S.empty k ------------------------------------------------------------------------------@@ -488,7 +483,7 @@ runPut (Put p) = p $ \x (BufferRange op _) -> return $ Done op x instance Functor Put where- fmap f p = Put $ \k -> unPut p (\x -> k (f x))+ fmap f p = Put $ \k -> unPut p (k . f) {-# INLINE fmap #-} -- | Synonym for '<*' from 'Applicative'; used in rewriting rules.@@ -506,7 +501,7 @@ {-# INLINE pure #-} pure x = Put $ \k -> k x {-# INLINE (<*>) #-}- Put f <*> Put a = Put $ \k -> f (\f' -> a (\a' -> k (f' a')))+ Put f <*> Put a = Put $ \k -> f (\f' -> a (k . f')) {-# INLINE (<*) #-} (<*) = ap_l {-# INLINE (*>) #-}@@ -531,7 +526,7 @@ -- | Convert a @'Put' ()@ action to a 'Builder'. {-# INLINE fromPut #-} fromPut :: Put () -> Builder-fromPut (Put p) = Builder $ \k -> p (\_ -> k)+fromPut (Put p) = Builder $ \k -> p (const k) -- We rewrite consecutive uses of 'putBuilder' such that the append of the -- involved 'Builder's is used. This can significantly improve performance,@@ -613,7 +608,6 @@ -- buffer is too small to execute one step of the 'Put' action, then -- it is replaced with a large enough buffer. hPut :: forall a. Handle -> Put a -> IO a-#if __GLASGOW_HASKELL__ >= 611 hPut h p = do fillHandle 1 (runPut p) where@@ -660,12 +654,7 @@ | freeSpace buf < minFree = flushWriteBuffer h_ | otherwise =-#if __GLASGOW_HASKELL__ >= 613 return ()-#else- -- required for ghc-6.12- flushWriteBuffer h_-#endif fillBuffer buf | freeSpace buf < minFree =@@ -714,16 +703,7 @@ return $ do S.hPut h bs fillHandle 1 nextStep-#else-hPut h p =- go =<< buildStepToCIOS strategy (runPut p)- where- strategy = untrimmedStrategy L.smallChunkSize L.defaultChunkSize - go (Finished buf x) = S.hPut h (byteStringFromBuffer buf) >> return x- go (Yield1 bs io) = S.hPut h bs >> io >>= go-#endif- -- | Execute a 'Put' and return the computed result and the bytes -- written during the computation as a lazy 'L.ByteString'. --@@ -775,7 +755,7 @@ -> (a, L.ByteString) -- ^ Result and lazy 'L.ByteString' -- written as its side-effect putToLazyByteString = putToLazyByteStringWith- (safeStrategy L.smallChunkSize L.defaultChunkSize) (\x -> (x, L.Empty))+ (safeStrategy L.smallChunkSize L.defaultChunkSize) (, L.Empty) -- | Execute a 'Put' with a buffer-allocation strategy and a continuation. For@@ -824,10 +804,10 @@ -- | Copy the bytes from a 'BufferRange' into the output stream. wrappedBytesCopyStep :: BufferRange -- ^ Input 'BufferRange'. -> BuildStep a -> BuildStep a-wrappedBytesCopyStep !(BufferRange ip0 ipe) k =+wrappedBytesCopyStep (BufferRange ip0 ipe) k = go ip0 where- go !ip !(BufferRange op ope)+ go !ip (BufferRange op ope) | inpRemaining <= outRemaining = do copyBytes op ip inpRemaining let !br' = BufferRange (op `plusPtr` inpRemaining) ope@@ -859,7 +839,7 @@ byteStringThreshold maxCopySize = \bs -> builder $ step bs where- step !bs@(S.BS _ len) !k br@(BufferRange !op _)+ step bs@(S.BS _ len) !k br@(BufferRange !op _) | len <= maxCopySize = byteStringCopyStep bs k br | otherwise = return $ insertChunk op bs k @@ -881,7 +861,7 @@ | op' <= ope = do copyBytes op ip isize touchForeignPtr ifp k0 (BufferRange op' ope)- | otherwise = do wrappedBytesCopyStep (BufferRange ip ipe) k br0+ | otherwise = wrappedBytesCopyStep (BufferRange ip ipe) k br0 where op' = op `plusPtr` isize ip = unsafeForeignPtrToPtr ifp@@ -918,7 +898,7 @@ shortByteStringCopyStep !sbs k = go 0 (Sh.length sbs) where- go !ip !ipe !(BufferRange op ope)+ go !ip !ipe (BufferRange op ope) | inpRemaining <= outRemaining = do Sh.copyToPtr sbs ip op inpRemaining let !br' = BufferRange (op `plusPtr` inpRemaining) ope@@ -1113,10 +1093,10 @@ :: AllocationStrategy -- ^ Buffer allocation strategy to use -> BuildStep a -- ^ 'BuildStep' to execute -> IO (ChunkIOStream a)-buildStepToCIOS !(AllocationStrategy nextBuffer bufSize trim) =+buildStepToCIOS (AllocationStrategy nextBuffer bufSize trim) = \step -> nextBuffer Nothing >>= fill step where- fill !step !buf@(Buffer fpbuf br@(BufferRange _ pe)) = do+ fill !step buf@(Buffer fpbuf br@(BufferRange _ pe)) = do res <- fillWithBuildStep step doneH fullH insertChunkH br touchForeignPtr fpbuf return res
Data/ByteString/Builder/Prim.hs view
@@ -458,14 +458,12 @@ ) where import Data.ByteString.Builder.Internal-import Data.ByteString.Builder.Prim.Internal.UncheckedShifts import qualified Data.ByteString as S import qualified Data.ByteString.Internal as S import qualified Data.ByteString.Lazy.Internal as L import Data.Monoid-import Data.List (unfoldr) -- HADDOCK ONLY import Data.Char (chr, ord) import Control.Monad ((<=<), unless) @@ -485,6 +483,7 @@ #else import Foreign #endif+import GHC.Word (Word8 (..)) import GHC.Exts import GHC.IO @@ -502,7 +501,7 @@ primMapListFixed :: FixedPrim a -> ([a] -> Builder) primMapListFixed = primMapListBounded . toB --- | Encode a list of values represented as an 'unfoldr' with a 'FixedPrim'.+-- | Encode a list of values represented as an 'Data.List.unfoldr' with a 'FixedPrim'. {-# INLINE primUnfoldrFixed #-} primUnfoldrFixed :: FixedPrim b -> (a -> Maybe (b, a)) -> a -> Builder primUnfoldrFixed = primUnfoldrBounded . toB@@ -618,12 +617,11 @@ primUnfoldrBounded w f x0 = builder $ fillWith x0 where- fillWith x k !(BufferRange op0 ope0) =+ fillWith x k (BufferRange op0 ope0) = go (f x) op0 where- go !Nothing !op = do let !br' = BufferRange op ope0- k br'- go !(Just (y, x')) !op+ go Nothing !op = k (BufferRange op ope0)+ go (Just (y, x')) !op | op `plusPtr` bound <= ope0 = runB w y op >>= go (f x') | otherwise = return $ bufferFull bound op $ \(BufferRange opNew opeNew) -> do@@ -649,7 +647,7 @@ goBS (unsafeForeignPtrToPtr ifp) where !ipe = unsafeForeignPtrToPtr ifp `plusPtr` isize- goBS !ip0 !br@(BufferRange op0 ope)+ goBS !ip0 br@(BufferRange op0 ope) | ip0 >= ipe = do touchForeignPtr ifp -- input buffer consumed k br@@ -695,8 +693,8 @@ \addr0 -> builder $ step addr0 where step :: Addr# -> BuildStep r -> BuildStep r- step !addr !k !br@(BufferRange op0@(Ptr op0#) ope)- | isTrue# (ch `eqWord#` 0##) = k br+ step !addr !k br@(BufferRange op0@(Ptr op0#) ope)+ | W8# ch == 0 = k br | op0 == ope = return $ bufferFull defaultChunkSize op0 (step addr k) | otherwise = do@@ -714,14 +712,15 @@ \addr0 -> builder $ step addr0 where step :: Addr# -> BuildStep r -> BuildStep r- step !addr !k !br@(BufferRange op0@(Ptr op0#) ope)- | isTrue# (ch `eqWord#` 0##) = k br+ step !addr !k br@(BufferRange op0@(Ptr op0#) ope)+ | W8# ch == 0 = k br | op0 == ope = return $ bufferFull defaultChunkSize op0 (step addr k) -- NULL is encoded as 0xc0 0x80- | isTrue# (ch `eqWord#` 0xc0##)- , isTrue# (indexWord8OffAddr# addr 1# `eqWord#` 0x80##) = do- IO $ \s -> case writeWord8OffAddr# op0# 0# 0## s of+ | W8# ch == 0xc0+ , W8# (indexWord8OffAddr# addr 1#) == 0x80 = do+ let !(W8# nullByte#) = 0+ IO $ \s -> case writeWord8OffAddr# op0# 0# nullByte# s of s' -> (# s', () #) let br' = BufferRange (op0 `plusPtr` 1) ope step (addr `plusAddr#` 2#) k br'@@ -754,7 +753,7 @@ where pokeN n io op = io op >> return (op `plusPtr` n) - f1 x1 = pokeN 1 $ \op -> do pokeByteOff op 0 x1+ f1 x1 = pokeN 1 $ \op -> pokeByteOff op 0 x1 f2 x1 x2 = pokeN 2 $ \op -> do pokeByteOff op 0 x1 pokeByteOff op 1 x2
Data/ByteString/Builder/Prim/ASCII.hs view
@@ -84,7 +84,6 @@ import Data.ByteString.Builder.Prim.Internal import Data.ByteString.Builder.Prim.Internal.Floating import Data.ByteString.Builder.Prim.Internal.Base16-import Data.ByteString.Builder.Prim.Internal.UncheckedShifts import Data.Char (ord) @@ -242,20 +241,20 @@ {-# INLINE word16HexFixed #-} word16HexFixed :: FixedPrim Word16 word16HexFixed =- (\x -> (fromIntegral $ x `shiftr_w16` 8, fromIntegral x))+ (\x -> (fromIntegral $ x `shiftR` 8, fromIntegral x)) >$< pairF word8HexFixed word8HexFixed -- | Encode a 'Word32' using 8 nibbles. {-# INLINE word32HexFixed #-} word32HexFixed :: FixedPrim Word32 word32HexFixed =- (\x -> (fromIntegral $ x `shiftr_w32` 16, fromIntegral x))+ (\x -> (fromIntegral $ x `shiftR` 16, fromIntegral x)) >$< pairF word16HexFixed word16HexFixed -- | Encode a 'Word64' using 16 nibbles. {-# INLINE word64HexFixed #-} word64HexFixed :: FixedPrim Word64 word64HexFixed =- (\x -> (fromIntegral $ x `shiftr_w64` 32, fromIntegral x))+ (\x -> (fromIntegral $ x `shiftR` 32, fromIntegral x)) >$< pairF word32HexFixed word32HexFixed -- | Encode a 'Int8' using 2 nibbles (hexadecimal digits).@@ -287,5 +286,3 @@ {-# INLINE doubleHexFixed #-} doubleHexFixed :: FixedPrim Double doubleHexFixed = encodeDoubleViaWord64F word64HexFixed--
Data/ByteString/Builder/Prim/Binary.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, BangPatterns #-}+{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 701 {-# LANGUAGE Trustworthy #-} #endif@@ -55,7 +55,6 @@ ) where import Data.ByteString.Builder.Prim.Internal-import Data.ByteString.Builder.Prim.Internal.UncheckedShifts import Data.ByteString.Builder.Prim.Internal.Floating import Foreign@@ -87,8 +86,8 @@ word16BE = word16Host #else word16BE = fixedPrim 2 $ \w p -> do- poke p (fromIntegral (shiftr_w16 w 8) :: Word8)- poke (p `plusPtr` 1) (fromIntegral (w) :: Word8)+ poke p (fromIntegral (shiftR w 8) :: Word8)+ poke (p `plusPtr` 1) (fromIntegral w :: Word8) #endif -- | Encoding 'Word16's in little endian format.@@ -96,8 +95,8 @@ word16LE :: FixedPrim Word16 #ifdef WORDS_BIGENDIAN word16LE = fixedPrim 2 $ \w p -> do- poke p (fromIntegral (w) :: Word8)- poke (p `plusPtr` 1) (fromIntegral (shiftr_w16 w 8) :: Word8)+ poke p (fromIntegral w :: Word8)+ poke (p `plusPtr` 1) (fromIntegral (shiftR w 8) :: Word8) #else word16LE = word16Host #endif@@ -109,10 +108,10 @@ word32BE = word32Host #else word32BE = fixedPrim 4 $ \w p -> do- poke p (fromIntegral (shiftr_w32 w 24) :: Word8)- poke (p `plusPtr` 1) (fromIntegral (shiftr_w32 w 16) :: Word8)- poke (p `plusPtr` 2) (fromIntegral (shiftr_w32 w 8) :: Word8)- poke (p `plusPtr` 3) (fromIntegral (w) :: Word8)+ poke p (fromIntegral (shiftR w 24) :: Word8)+ poke (p `plusPtr` 1) (fromIntegral (shiftR w 16) :: Word8)+ poke (p `plusPtr` 2) (fromIntegral (shiftR w 8) :: Word8)+ poke (p `plusPtr` 3) (fromIntegral w :: Word8) #endif -- | Encoding 'Word32's in little endian format.@@ -120,10 +119,10 @@ word32LE :: FixedPrim Word32 #ifdef WORDS_BIGENDIAN word32LE = fixedPrim 4 $ \w p -> do- poke p (fromIntegral (w) :: Word8)- poke (p `plusPtr` 1) (fromIntegral (shiftr_w32 w 8) :: Word8)- poke (p `plusPtr` 2) (fromIntegral (shiftr_w32 w 16) :: Word8)- poke (p `plusPtr` 3) (fromIntegral (shiftr_w32 w 24) :: Word8)+ poke p (fromIntegral w :: Word8)+ poke (p `plusPtr` 1) (fromIntegral (shiftR w 8) :: Word8)+ poke (p `plusPtr` 2) (fromIntegral (shiftR w 16) :: Word8)+ poke (p `plusPtr` 3) (fromIntegral (shiftR w 24) :: Word8) #else word32LE = word32Host #endif@@ -144,26 +143,26 @@ -- word64BE = fixedPrim 8 $ \w p -> do- let a = fromIntegral (shiftr_w64 w 32) :: Word32+ let a = fromIntegral (shiftR w 32) :: Word32 b = fromIntegral w :: Word32- poke p (fromIntegral (shiftr_w32 a 24) :: Word8)- poke (p `plusPtr` 1) (fromIntegral (shiftr_w32 a 16) :: Word8)- poke (p `plusPtr` 2) (fromIntegral (shiftr_w32 a 8) :: Word8)- poke (p `plusPtr` 3) (fromIntegral (a) :: Word8)- poke (p `plusPtr` 4) (fromIntegral (shiftr_w32 b 24) :: Word8)- poke (p `plusPtr` 5) (fromIntegral (shiftr_w32 b 16) :: Word8)- poke (p `plusPtr` 6) (fromIntegral (shiftr_w32 b 8) :: Word8)- poke (p `plusPtr` 7) (fromIntegral (b) :: Word8)+ poke p (fromIntegral (shiftR a 24) :: Word8)+ poke (p `plusPtr` 1) (fromIntegral (shiftR a 16) :: Word8)+ poke (p `plusPtr` 2) (fromIntegral (shiftR a 8) :: Word8)+ poke (p `plusPtr` 3) (fromIntegral a :: Word8)+ poke (p `plusPtr` 4) (fromIntegral (shiftR b 24) :: Word8)+ poke (p `plusPtr` 5) (fromIntegral (shiftR b 16) :: Word8)+ poke (p `plusPtr` 6) (fromIntegral (shiftR b 8) :: Word8)+ poke (p `plusPtr` 7) (fromIntegral b :: Word8) #else word64BE = fixedPrim 8 $ \w p -> do- poke p (fromIntegral (shiftr_w64 w 56) :: Word8)- poke (p `plusPtr` 1) (fromIntegral (shiftr_w64 w 48) :: Word8)- poke (p `plusPtr` 2) (fromIntegral (shiftr_w64 w 40) :: Word8)- poke (p `plusPtr` 3) (fromIntegral (shiftr_w64 w 32) :: Word8)- poke (p `plusPtr` 4) (fromIntegral (shiftr_w64 w 24) :: Word8)- poke (p `plusPtr` 5) (fromIntegral (shiftr_w64 w 16) :: Word8)- poke (p `plusPtr` 6) (fromIntegral (shiftr_w64 w 8) :: Word8)- poke (p `plusPtr` 7) (fromIntegral (w) :: Word8)+ poke p (fromIntegral (shiftR w 56) :: Word8)+ poke (p `plusPtr` 1) (fromIntegral (shiftR w 48) :: Word8)+ poke (p `plusPtr` 2) (fromIntegral (shiftR w 40) :: Word8)+ poke (p `plusPtr` 3) (fromIntegral (shiftR w 32) :: Word8)+ poke (p `plusPtr` 4) (fromIntegral (shiftR w 24) :: Word8)+ poke (p `plusPtr` 5) (fromIntegral (shiftR w 16) :: Word8)+ poke (p `plusPtr` 6) (fromIntegral (shiftR w 8) :: Word8)+ poke (p `plusPtr` 7) (fromIntegral w :: Word8) #endif #endif @@ -174,26 +173,26 @@ #if WORD_SIZE_IN_BITS < 64 word64LE = fixedPrim 8 $ \w p -> do- let b = fromIntegral (shiftr_w64 w 32) :: Word32+ let b = fromIntegral (shiftR w 32) :: Word32 a = fromIntegral w :: Word32- poke (p) (fromIntegral (a) :: Word8)- poke (p `plusPtr` 1) (fromIntegral (shiftr_w32 a 8) :: Word8)- poke (p `plusPtr` 2) (fromIntegral (shiftr_w32 a 16) :: Word8)- poke (p `plusPtr` 3) (fromIntegral (shiftr_w32 a 24) :: Word8)- poke (p `plusPtr` 4) (fromIntegral (b) :: Word8)- poke (p `plusPtr` 5) (fromIntegral (shiftr_w32 b 8) :: Word8)- poke (p `plusPtr` 6) (fromIntegral (shiftr_w32 b 16) :: Word8)- poke (p `plusPtr` 7) (fromIntegral (shiftr_w32 b 24) :: Word8)+ poke (p) (fromIntegral a :: Word8)+ poke (p `plusPtr` 1) (fromIntegral (shiftR a 8) :: Word8)+ poke (p `plusPtr` 2) (fromIntegral (shiftR a 16) :: Word8)+ poke (p `plusPtr` 3) (fromIntegral (shiftR a 24) :: Word8)+ poke (p `plusPtr` 4) (fromIntegral b :: Word8)+ poke (p `plusPtr` 5) (fromIntegral (shiftR b 8) :: Word8)+ poke (p `plusPtr` 6) (fromIntegral (shiftR b 16) :: Word8)+ poke (p `plusPtr` 7) (fromIntegral (shiftR b 24) :: Word8) #else word64LE = fixedPrim 8 $ \w p -> do- poke p (fromIntegral (w) :: Word8)- poke (p `plusPtr` 1) (fromIntegral (shiftr_w64 w 8) :: Word8)- poke (p `plusPtr` 2) (fromIntegral (shiftr_w64 w 16) :: Word8)- poke (p `plusPtr` 3) (fromIntegral (shiftr_w64 w 24) :: Word8)- poke (p `plusPtr` 4) (fromIntegral (shiftr_w64 w 32) :: Word8)- poke (p `plusPtr` 5) (fromIntegral (shiftr_w64 w 40) :: Word8)- poke (p `plusPtr` 6) (fromIntegral (shiftr_w64 w 48) :: Word8)- poke (p `plusPtr` 7) (fromIntegral (shiftr_w64 w 56) :: Word8)+ poke p (fromIntegral w :: Word8)+ poke (p `plusPtr` 1) (fromIntegral (shiftR w 8) :: Word8)+ poke (p `plusPtr` 2) (fromIntegral (shiftR w 16) :: Word8)+ poke (p `plusPtr` 3) (fromIntegral (shiftR w 24) :: Word8)+ poke (p `plusPtr` 4) (fromIntegral (shiftR w 32) :: Word8)+ poke (p `plusPtr` 5) (fromIntegral (shiftR w 40) :: Word8)+ poke (p `plusPtr` 6) (fromIntegral (shiftR w 48) :: Word8)+ poke (p `plusPtr` 7) (fromIntegral (shiftR w 56) :: Word8) #endif #else word64LE = word64Host@@ -332,5 +331,3 @@ {-# INLINE doubleHost #-} doubleHost :: FixedPrim Double doubleHost = storableToF--
Data/ByteString/Builder/Prim/Internal.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE ScopedTypeVariables, CPP, BangPatterns #-}+{-# LANGUAGE ScopedTypeVariables, CPP #-} #if __GLASGOW_HASKELL__ >= 703 {-# LANGUAGE Unsafe #-} #endif@@ -64,6 +64,9 @@ , (>$<) , (>*<) + -- * Helpers+ , caseWordSize_32_64+ -- * Deprecated , boudedPrim ) where@@ -71,10 +74,7 @@ import Foreign import Prelude hiding (maxBound) -#if !(__GLASGOW_HASKELL__ >= 612)--- ghc-6.10 and older do not support {-# INLINE CONLIKE #-}-#define CONLIKE-#endif+#include "MachDeps.h" ------------------------------------------------------------------------------ -- Supporting infrastructure@@ -187,7 +187,7 @@ -- >contramapF f . contramapF g = contramapF (g . f) {-# INLINE CONLIKE contramapF #-} contramapF :: (b -> a) -> FixedPrim a -> FixedPrim b-contramapF f (FP l io) = FP l (\x op -> io (f x) op)+contramapF f (FP l io) = FP l (io . f) -- | Convert a 'FixedPrim' to a 'BoundedPrim'. {-# INLINE CONLIKE toB #-}@@ -211,7 +211,7 @@ storableToF = FP (sizeOf (undefined :: a)) (\x op -> poke (castPtr op) x) #else storableToF = FP (sizeOf (undefined :: a)) $ \x op ->- if (ptrToWordPtr op) `mod` (fromIntegral (alignment (undefined :: a))) == 0 then poke (castPtr op) x+ if ptrToWordPtr op `mod` fromIntegral (alignment (undefined :: a)) == 0 then poke (castPtr op) x else with x $ \tp -> copyBytes op (castPtr tp) (sizeOf (undefined :: a)) #endif @@ -257,7 +257,7 @@ -- >contramapB f . contramapB g = contramapB (g . f) {-# INLINE CONLIKE contramapB #-} contramapB :: (b -> a) -> BoundedPrim a -> BoundedPrim b-contramapB f (BP b io) = BP b (\x op -> io (f x) op)+contramapB f (BP b io) = BP b (io . f) -- | The 'BoundedPrim' that always results in the zero-length sequence. {-# INLINE CONLIKE emptyB #-}@@ -298,3 +298,17 @@ condB :: (a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a condB p be1 be2 = contramapB (\x -> if p x then Left x else Right x) (eitherB be1 be2)++-- | Select an implementation depending on bitness.+-- Throw a compile time error if bitness is neither 32 nor 64.+{-# INLINE caseWordSize_32_64 #-}+caseWordSize_32_64+ :: a -- Value for 32-bit architecture+ -> a -- Value for 64-bit architecture+ -> a+#if WORD_SIZE_IN_BITS == 32+caseWordSize_32_64 = const+#endif+#if WORD_SIZE_IN_BITS == 64+caseWordSize_32_64 = const id+#endif
Data/ByteString/Builder/Prim/Internal/Floating.hs view
@@ -38,7 +38,7 @@ encodeFloatViaWord32F :: FixedPrim Word32 -> FixedPrim Float encodeFloatViaWord32F w32fe | size w32fe < sizeOf (undefined :: Float) =- error $ "encodeFloatViaWord32F: encoding not wide enough"+ error "encodeFloatViaWord32F: encoding not wide enough" | otherwise = fixedPrim (size w32fe) $ \x op -> do poke (castPtr op) x x' <- peek (castPtr op)@@ -51,7 +51,7 @@ encodeDoubleViaWord64F :: FixedPrim Word64 -> FixedPrim Double encodeDoubleViaWord64F w64fe | size w64fe < sizeOf (undefined :: Float) =- error $ "encodeDoubleViaWord64F: encoding not wide enough"+ error "encodeDoubleViaWord64F: encoding not wide enough" | otherwise = fixedPrim (size w64fe) $ \x op -> do poke (castPtr op) x x' <- peek (castPtr op)
− Data/ByteString/Builder/Prim/Internal/UncheckedShifts.hs
@@ -1,107 +0,0 @@-{-# LANGUAGE CPP, MagicHash #-}-#if __GLASGOW_HASKELL__ >= 703-{-# LANGUAGE Unsafe #-}-#endif--- |--- Copyright : (c) 2010 Simon Meier------ Original serialization code from 'Data.Binary.Builder':--- (c) Lennart Kolmodin, Ross Patterson------ License : BSD3-style (see LICENSE)------ Maintainer : Simon Meier <iridcode@gmail.com>--- Portability : GHC------ Utilty module defining unchecked shifts.------ These functions are undefined when the amount being shifted by is--- greater than the size in bits of a machine Int#.-----#if !defined(__HADDOCK__)-#include "MachDeps.h"-#endif--module Data.ByteString.Builder.Prim.Internal.UncheckedShifts (- shiftr_w16- , shiftr_w32- , shiftr_w64- , shiftr_w-- , caseWordSize_32_64- ) where---#if !defined(__HADDOCK__)-import GHC.Base-import GHC.Word (Word32(..),Word16(..),Word64(..))--#if WORD_SIZE_IN_BITS < 64 && __GLASGOW_HASKELL__ >= 608-import GHC.Word (uncheckedShiftRL64#)-#endif-#else-import Data.Word-#endif--import Foreign------------------------------------------------------------------------------ Unchecked shifts---- | Right-shift of a 'Word16'.-{-# INLINE shiftr_w16 #-}-shiftr_w16 :: Word16 -> Int -> Word16---- | Right-shift of a 'Word32'.-{-# INLINE shiftr_w32 #-}-shiftr_w32 :: Word32 -> Int -> Word32---- | Right-shift of a 'Word64'.-{-# INLINE shiftr_w64 #-}-shiftr_w64 :: Word64 -> Int -> Word64---- | Right-shift of a 'Word'.-{-# INLINE shiftr_w #-}-shiftr_w :: Word -> Int -> Word-#if WORD_SIZE_IN_BITS < 64-shiftr_w w s = fromIntegral $ (`shiftr_w32` s) $ fromIntegral w-#else-shiftr_w w s = fromIntegral $ (`shiftr_w64` s) $ fromIntegral w-#endif--#if !defined(__HADDOCK__)-shiftr_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftRL#` i)-shiftr_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftRL#` i)--#if WORD_SIZE_IN_BITS < 64-shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL64#` i)-#else-shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL#` i)-#endif--#else-shiftr_w16 = shiftR-shiftr_w32 = shiftR-shiftr_w64 = shiftR-#endif----- | Select an implementation depending on the bit-size of 'Word's.--- Currently, it produces a runtime failure if the bitsize is different.--- This is detected by the testsuite.-{-# INLINE caseWordSize_32_64 #-}-caseWordSize_32_64 :: a -- Value to use for 32-bit 'Word's- -> a -- Value to use for 64-bit 'Word's- -> a-caseWordSize_32_64 f32 f64 =-#if MIN_VERSION_base(4,7,0)- case finiteBitSize (undefined :: Word) of-#else- case bitSize (undefined :: Word) of-#endif- 32 -> f32- 64 -> f64- s -> error $ "caseWordSize_32_64: unsupported Word bit-size " ++ show s--
Data/ByteString/Char8.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE CPP, BangPatterns #-}-{-# LANGUAGE MagicHash #-} {-# OPTIONS_HADDOCK prune #-} #if __GLASGOW_HASKELL__ >= 701 {-# LANGUAGE Trustworthy #-}@@ -114,7 +113,9 @@ -- ** Breaking strings take, -- :: Int -> ByteString -> ByteString+ takeEnd, -- :: Int -> ByteString -> ByteString drop, -- :: Int -> ByteString -> ByteString+ dropEnd, -- :: Int -> ByteString -> ByteString splitAt, -- :: Int -> ByteString -> (ByteString, ByteString) takeWhile, -- :: (Char -> Bool) -> ByteString -> ByteString takeWhileEnd, -- :: (Char -> Bool) -> ByteString -> ByteString@@ -171,11 +172,13 @@ elemIndexEnd, -- :: Char -> ByteString -> Maybe Int findIndex, -- :: (Char -> Bool) -> ByteString -> Maybe Int findIndices, -- :: (Char -> Bool) -> ByteString -> [Int]+ findIndexEnd, -- :: (Char -> Bool) -> ByteString -> Maybe Int count, -- :: Char -> ByteString -> Int -- * Zipping and unzipping ByteStrings zip, -- :: ByteString -> ByteString -> [(Char,Char)] zipWith, -- :: (Char -> Char -> c) -> ByteString -> ByteString -> [c]+ packZipWith, -- :: (Char -> Char -> Char) -> ByteString -> ByteString -> ByteString unzip, -- :: [(Char,Char)] -> (ByteString,ByteString) -- * Ordered ByteStrings@@ -248,9 +251,9 @@ -- Listy functions transparently exported import Data.ByteString (empty,null,length,tail,init,append ,inits,tails,reverse,transpose- ,concat,take,drop,splitAt,intercalate- ,sort,isPrefixOf,isSuffixOf,isInfixOf- ,stripPrefix,stripSuffix+ ,concat,take,takeEnd,drop,dropEnd,splitAt+ ,intercalate,sort,isPrefixOf,isSuffixOf+ ,isInfixOf,stripPrefix,stripSuffix ,breakSubstring,copy,group ,getLine, getContents, putStr, interact@@ -263,6 +266,10 @@ import Data.ByteString.Internal +#if !(MIN_VERSION_base(4,8,0))+import Control.Applicative ((<$>))+#endif+ import Data.Char ( isSpace ) #if MIN_VERSION_base(4,9,0) -- See bytestring #70@@ -363,12 +370,12 @@ -- (typically the right-identity of the operator), and a packed string, -- reduces the packed string using the binary operator, from right to left. foldr :: (Char -> a -> a) -> a -> ByteString -> a-foldr f = B.foldr (\c a -> f (w2c c) a)+foldr f = B.foldr (f . w2c) {-# INLINE foldr #-} -- | 'foldr'' is a strict variant of foldr foldr' :: (Char -> a -> a) -> a -> ByteString -> a-foldr' f = B.foldr' (\c a -> f (w2c c) a)+foldr' f = B.foldr' (f . w2c) {-# INLINE foldr' #-} -- | 'foldl1' is a variant of 'foldl' that has no starting value@@ -480,7 +487,7 @@ -- -- > unfoldr (\x -> if x <= '9' then Just (x, succ x) else Nothing) '0' == "0123456789" unfoldr :: (a -> Maybe (Char, a)) -> a -> ByteString-unfoldr f x = B.unfoldr (fmap k . f) x+unfoldr f = B.unfoldr (fmap k . f) where k (i, j) = (c2w i, j) -- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a ByteString from a seed@@ -678,8 +685,9 @@ -- element, or 'Nothing' if there is no such element. The following -- holds: ----- > elemIndexEnd c xs ==--- > (-) (length xs - 1) `fmap` elemIndex c (reverse xs)+-- > elemIndexEnd c xs = case elemIndex c (reverse xs) of+-- > Nothing -> Nothing+-- > Just i -> Just (length xs - 1 - i) -- elemIndexEnd :: Char -> ByteString -> Maybe Int elemIndexEnd = B.elemIndexEnd . c2w@@ -697,6 +705,15 @@ findIndex f = B.findIndex (f . w2c) {-# INLINE [1] findIndex #-} +-- | /O(n)/ The 'findIndexEnd' function takes a predicate and a 'ByteString' and+-- returns the index of the last element in the ByteString+-- satisfying the predicate.+--+-- @since 0.11.1.0+findIndexEnd :: (Char -> Bool) -> ByteString -> Maybe Int+findIndexEnd f = B.findIndexEnd (f . w2c)+{-# INLINE [1] findIndexEnd #-}+ -- | The 'findIndices' function extends 'findIndex', by returning the -- indices of all elements satisfying the predicate, in ascending order. findIndices :: (Char -> Bool) -> ByteString -> [Int]@@ -826,9 +843,11 @@ -- equivalent to a pair of 'unpack' operations, and so space -- usage may be large for multi-megabyte ByteStrings zip :: ByteString -> ByteString -> [(Char,Char)]-zip ps qs- | B.null ps || B.null qs = []- | otherwise = (unsafeHead ps, unsafeHead qs) : zip (B.unsafeTail ps) (B.unsafeTail qs)+zip ps qs = case uncons ps of+ Nothing -> []+ Just (psH, psT) -> case uncons qs of+ Nothing -> []+ Just (qsH, qsT) -> (psH, qsH) : zip psT qsT -- | 'zipWith' generalises 'zip' by zipping with the function given as -- the first argument, instead of a tupling function. For example,@@ -837,6 +856,16 @@ zipWith :: (Char -> Char -> a) -> ByteString -> ByteString -> [a] zipWith f = B.zipWith ((. w2c) . f . w2c) +-- | A specialised version of `zipWith` for the common case of a+-- simultaneous map over two ByteStrings, to build a 3rd.+--+-- @since 0.11.1.0+packZipWith :: (Char -> Char -> Char) -> ByteString -> ByteString -> ByteString+packZipWith f = B.packZipWith f'+ where+ f' c1 c2 = c2w $ f (w2c c1) (w2c c2)+{-# INLINE packZipWith #-}+ -- | 'unzip' transforms a list of pairs of Chars into a pair of -- ByteStrings. Note that this performs two 'pack' operations. unzip :: [(Char,Char)] -> (ByteString,ByteString)@@ -865,7 +894,7 @@ -- > break isSpace == breakSpace -- breakSpace :: ByteString -> (ByteString,ByteString)-breakSpace (BS x l) = accursedUnutterablePerformIO $ withForeignPtr x $ \p -> do+breakSpace (BS x l) = accursedUnutterablePerformIO $ unsafeWithForeignPtr x $ \p -> do i <- firstspace p 0 l return $! case () of {_ | i == 0 -> (empty, BS x l)@@ -888,7 +917,7 @@ -- -- @since 0.10.12.0 dropSpace :: ByteString -> ByteString-dropSpace (BS x l) = accursedUnutterablePerformIO $ withForeignPtr x $ \p -> do+dropSpace (BS x l) = accursedUnutterablePerformIO $ unsafeWithForeignPtr x $ \p -> do i <- firstnonspace p 0 l return $! if i == l then empty else BS (plusForeignPtr x i) (l-i) {-# INLINE dropSpace #-}@@ -914,7 +943,7 @@ -- but it is more efficient than using multiple reverses. -- dropSpaceEnd :: ByteString -> ByteString-dropSpaceEnd (BS x l) = accursedUnutterablePerformIO $ withForeignPtr x $ \p -> do+dropSpaceEnd (BS x l) = accursedUnutterablePerformIO $ unsafeWithForeignPtr x $ \p -> do i <- lastnonspace p (l-1) return $! if i == (-1) then empty else BS x (i+1) {-# INLINE dropSpaceEnd #-}@@ -947,7 +976,7 @@ nl = c2w '\n' -- It is important to remain lazy in the tail of the list. The caller -- might only want the first few lines.- go !f !len = accursedUnutterablePerformIO $ withForeignPtr f $ \p -> do+ go !f !len = accursedUnutterablePerformIO $ unsafeWithForeignPtr f $ \p -> do q <- memchr p nl $! fromIntegral len if q == nullPtr then return [BS f len]@@ -1050,7 +1079,7 @@ combine1 _ [n] = n combine1 b ns = combine1 (b*b) $ combine2 b ns - combine2 b (n:m:ns) = let t = m*b + n in t `seq` (t : combine2 b ns)+ combine2 b (n:m:ns) = let !t = m*b + n in t : combine2 b ns combine2 _ ns = ns ------------------------------------------------------------------------
Data/ByteString/Internal.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE CPP, ForeignFunctionInterface, BangPatterns #-} {-# LANGUAGE UnliftedFFITypes, MagicHash, UnboxedTuples, DeriveDataTypeable #-}+{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} #if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE PatternSynonyms, ViewPatterns #-}@@ -37,6 +38,9 @@ #endif ), -- instances: Eq, Ord, Show, Read, Data, Typeable + -- * Internal indexing+ findIndexOrLength,+ -- * Conversion with lists: packing and unpacking packBytes, packUptoLenBytes, unsafePackLenBytes, packChars, packUptoLenChars, unsafePackLenChars,@@ -89,14 +93,17 @@ accursedUnutterablePerformIO, -- :: IO a -> a -- * Exported compatibility shim- plusForeignPtr+ plusForeignPtr,+ unsafeWithForeignPtr ) where import Prelude hiding (concat, null) import qualified Data.List as List +import Control.Monad (void)+ import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)-import Foreign.Ptr (Ptr, FunPtr, plusPtr)+import Foreign.Ptr (Ptr, FunPtr, plusPtr, minusPtr) import Foreign.Storable (Storable(..)) #if MIN_VERSION_base(4,5,0) || __GLASGOW_HASKELL__ >= 703@@ -108,10 +115,10 @@ import Foreign.C.String (CString) #if MIN_VERSION_base(4,13,0)-import Data.Semigroup (Semigroup (sconcat))+import Data.Semigroup (Semigroup (sconcat, stimes)) import Data.List.NonEmpty (NonEmpty ((:|))) #elif MIN_VERSION_base(4,9,0)-import Data.Semigroup (Semigroup ((<>), sconcat))+import Data.Semigroup (Semigroup ((<>), sconcat, stimes)) import Data.List.NonEmpty (NonEmpty ((:|))) #endif @@ -126,8 +133,9 @@ import Control.Exception (assert) +import Data.Bits ((.&.)) import Data.Char (ord)-import Data.Word (Word8)+import Data.Word import Data.Typeable (Typeable) import Data.Data (Data(..), mkNoRepType)@@ -146,27 +154,40 @@ import GHC.Prim (Addr#) -#if __GLASGOW_HASKELL__ >= 611 import GHC.IO (IO(IO),unsafeDupablePerformIO)-#else-import GHC.IOBase (IO(IO),RawBuffer,unsafeDupablePerformIO)-#endif import GHC.ForeignPtr (ForeignPtr(ForeignPtr)- ,newForeignPtr_, mallocPlainForeignPtrBytes)+#if __GLASGOW_HASKELL__ < 900+ , newForeignPtr_+#endif+ , mallocPlainForeignPtrBytes)+ #if MIN_VERSION_base(4,10,0) import GHC.ForeignPtr (plusForeignPtr) #else-import GHC.Types (Int (..)) import GHC.Prim (plusAddr#) #endif #if __GLASGOW_HASKELL__ >= 811 import GHC.CString (cstringLength#) import GHC.ForeignPtr (ForeignPtrContents(FinalPtr))-#endif+#else import GHC.Ptr (Ptr(..), castPtr)+#endif +#if (__GLASGOW_HASKELL__ < 802) || (__GLASGOW_HASKELL__ >= 811)+import GHC.Types (Int (..))+#endif++#if MIN_VERSION_base(4,15,0)+import GHC.ForeignPtr (unsafeWithForeignPtr)+#endif++#if !MIN_VERSION_base(4,15,0)+unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b+unsafeWithForeignPtr = withForeignPtr+#endif+ -- CFILES stuff is Hugs only {-# CFILES cbits/fpstring.c #-} @@ -218,10 +239,12 @@ -- as the base will be manipulated by 'plusForeignPtr' instead. -- pattern PS :: ForeignPtr Word8 -> Int -> Int -> ByteString-pattern PS fp zero len <- BS fp (((,) 0) -> (zero, len)) where+pattern PS fp zero len <- BS fp ((0,) -> (zero, len)) where PS fp o len = BS (plusForeignPtr fp o) len+#if __GLASGOW_HASKELL__ >= 802 {-# COMPLETE PS #-} #endif+#endif instance Eq ByteString where (==) = eq@@ -233,6 +256,7 @@ instance Semigroup ByteString where (<>) = append sconcat (b:|bs) = concat (b:bs)+ stimes = times #endif instance Monoid ByteString where@@ -274,6 +298,24 @@ dataTypeOf _ = mkNoRepType "Data.ByteString.ByteString" ------------------------------------------------------------------------+-- Internal indexing++-- | 'findIndexOrLength' is a variant of findIndex, that returns the length+-- of the string if no element is found, rather than Nothing.+findIndexOrLength :: (Word8 -> Bool) -> ByteString -> Int+findIndexOrLength k (BS x l) =+ accursedUnutterablePerformIO $ withForeignPtr x g+ where+ g ptr = go 0+ where+ go !n | n >= l = return l+ | otherwise = do w <- peek $ ptr `plusPtr` n+ if k w+ then return n+ else go (n+1)+{-# INLINE findIndexOrLength #-}++------------------------------------------------------------------------ -- Packing and unpacking from lists packBytes :: [Word8] -> ByteString@@ -357,19 +399,21 @@ packUptoLenBytes :: Int -> [Word8] -> (ByteString, [Word8]) packUptoLenBytes len xs0 =- unsafeCreateUptoN' len $ \p -> go p len xs0- where- go !_ !n [] = return (len-n, [])- go !_ !0 xs = return (len, xs)- go !p !n (x:xs) = poke p x >> go (p `plusPtr` 1) (n-1) xs+ unsafeCreateUptoN' len $ \p0 ->+ let p_end = plusPtr p0 len+ go !p [] = return (p `minusPtr` p0, [])+ go !p xs | p == p_end = return (len, xs)+ go !p (x:xs) = poke p x >> go (p `plusPtr` 1) xs+ in go p0 xs0 packUptoLenChars :: Int -> [Char] -> (ByteString, [Char]) packUptoLenChars len cs0 =- unsafeCreateUptoN' len $ \p -> go p len cs0- where- go !_ !n [] = return (len-n, [])- go !_ !0 cs = return (len, cs)- go !p !n (c:cs) = poke p (c2w c) >> go (p `plusPtr` 1) (n-1) cs+ unsafeCreateUptoN' len $ \p0 ->+ let p_end = plusPtr p0 len+ go !p [] = return (p `minusPtr` p0, [])+ go !p cs | p == p_end = return (len, cs)+ go !p (c:cs) = poke p (c2w c) >> go (p `plusPtr` 1) cs+ in go p0 cs0 -- Unpacking bytestrings into lists efficiently is a tradeoff: on the one hand -- we would like to write a tight loop that just blasts the list into memory, on@@ -413,7 +457,7 @@ unpackAppendBytesStrict :: ByteString -> [Word8] -> [Word8] unpackAppendBytesStrict (BS fp len) xs =- accursedUnutterablePerformIO $ withForeignPtr fp $ \base ->+ accursedUnutterablePerformIO $ unsafeWithForeignPtr fp $ \base -> loop (base `plusPtr` (-1)) (base `plusPtr` (-1+len)) xs where loop !sentinal !p acc@@ -423,7 +467,7 @@ unpackAppendCharsStrict :: ByteString -> [Char] -> [Char] unpackAppendCharsStrict (BS fp len) xs =- accursedUnutterablePerformIO $ withForeignPtr fp $ \base ->+ accursedUnutterablePerformIO $ unsafeWithForeignPtr fp $ \base -> loop (base `plusPtr` (-1)) (base `plusPtr` (-1+len)) xs where loop !sentinal !p acc@@ -454,7 +498,7 @@ -> Int -- ^ Offset -> Int -- ^ Length -> ByteString-fromForeignPtr fp o len = BS (plusForeignPtr fp o) len+fromForeignPtr fp o = BS (plusForeignPtr fp o) {-# INLINE fromForeignPtr #-} fromForeignPtr0 :: ForeignPtr Word8@@ -571,8 +615,8 @@ compareBytes (BS _ 0) (BS _ 0) = EQ -- short cut for empty strings compareBytes (BS fp1 len1) (BS fp2 len2) = accursedUnutterablePerformIO $- withForeignPtr fp1 $ \p1 ->- withForeignPtr fp2 $ \p2 -> do+ unsafeWithForeignPtr fp1 $ \p1 ->+ unsafeWithForeignPtr fp2 $ \p2 -> do i <- memcmp p1 p2 (min len1 len2) return $! case i `compare` 0 of EQ -> len1 `compare` len2@@ -584,8 +628,8 @@ append (BS fp1 len1) (BS fp2 len2) = unsafeCreate (len1+len2) $ \destptr1 -> do let destptr2 = destptr1 `plusPtr` len1- withForeignPtr fp1 $ \p1 -> memcpy destptr1 p1 len1- withForeignPtr fp2 $ \p2 -> memcpy destptr2 p2 len2+ unsafeWithForeignPtr fp1 $ \p1 -> memcpy destptr1 p1 len1+ unsafeWithForeignPtr fp2 $ \p2 -> memcpy destptr2 p2 len2 concat :: [ByteString] -> ByteString concat = \bss0 -> goLen0 bss0 bss0@@ -627,7 +671,7 @@ goCopy [] !_ = return () goCopy (BS _ 0 :bss) !ptr = goCopy bss ptr goCopy (BS fp len:bss) !ptr = do- withForeignPtr fp $ \p -> memcpy ptr p len+ unsafeWithForeignPtr fp $ \p -> memcpy ptr p len goCopy bss (ptr `plusPtr` len) {-# NOINLINE concat #-} @@ -638,6 +682,33 @@ concat [x] = x #-} +#if MIN_VERSION_base(4,9,0)+-- | /O(log n)/ Repeats the given ByteString n times.+times :: Integral a => a -> ByteString -> ByteString+times n (BS fp len)+ | n < 0 = error "stimes: non-negative multiplier expected"+ | n == 0 = mempty+ | n == 1 = BS fp len+ | len == 0 = mempty+ | len == 1 = unsafeCreate size $ \destptr ->+ unsafeWithForeignPtr fp $ \p -> do+ byte <- peek p+ void $ memset destptr byte (fromIntegral size)+ | otherwise = unsafeCreate size $ \destptr ->+ unsafeWithForeignPtr fp $ \p -> do+ memcpy destptr p len+ fillFrom destptr len+ where+ size = len * fromIntegral n++ fillFrom :: Ptr Word8 -> Int -> IO ()+ fillFrom destptr copied+ | 2 * copied < size = do+ memcpy (destptr `plusPtr` copied) destptr copied+ fillFrom destptr (copied * 2)+ | otherwise = memcpy (destptr `plusPtr` copied) destptr (size - copied)+#endif+ -- | Add two non-negative numbers. Errors out on overflow. checkedAdd :: String -> Int -> Int -> Int checkedAdd fun x y@@ -661,28 +732,22 @@ {-# INLINE c2w #-} -- | Selects words corresponding to white-space characters in the Latin-1 range--- ordered by frequency. isSpaceWord8 :: Word8 -> Bool-isSpaceWord8 w =- w == 0x20 ||- w == 0x0A || -- LF, \n- w == 0x09 || -- HT, \t- w == 0x0C || -- FF, \f- w == 0x0D || -- CR, \r- w == 0x0B || -- VT, \v- w == 0xA0 -- spotted by QC..+isSpaceWord8 w8 =+ -- Avoid the cost of narrowing arithmetic results to Word8,+ -- the conversion from Word8 to Word is free.+ let w :: Word+ !w = fromIntegral w8+ in w .&. 0x50 == 0 -- Quick non-whitespace filter+ && w - 0x21 > 0x7e -- Second non-whitespace filter+ && ( w == 0x20 -- SP+ || w == 0xa0 -- NBSP+ || w - 0x09 < 5) -- HT, NL, VT, FF, CR {-# INLINE isSpaceWord8 #-} -- | Selects white-space characters in the Latin-1 range isSpaceChar8 :: Char -> Bool-isSpaceChar8 c =- c == ' ' ||- c == '\t' ||- c == '\n' ||- c == '\r' ||- c == '\f' ||- c == '\v' ||- c == '\xa0'+isSpaceChar8 = isSpaceWord8 . c2w {-# INLINE isSpaceChar8 #-} overflowError :: String -> a@@ -733,7 +798,7 @@ :: Ptr Word8 -> CInt -> CSize -> IO (Ptr Word8) memchr :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)-memchr p w s = c_memchr p (fromIntegral w) s+memchr p w = c_memchr p (fromIntegral w) foreign import ccall unsafe "string.h memcmp" c_memcmp :: Ptr Word8 -> Ptr Word8 -> CSize -> IO CInt@@ -745,7 +810,7 @@ :: Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8) memcpy :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()-memcpy p q s = c_memcpy p q (fromIntegral s) >> return ()+memcpy p q s = void $ c_memcpy p q (fromIntegral s) {- foreign import ccall unsafe "string.h memmove" c_memmove@@ -760,7 +825,7 @@ :: Ptr Word8 -> CInt -> CSize -> IO (Ptr Word8) memset :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)-memset p w s = c_memset p (fromIntegral w) s+memset p w = c_memset p (fromIntegral w) -- --------------------------------------------------------------------- --
Data/ByteString/Lazy.hs view
@@ -102,6 +102,7 @@ all, -- :: (Word8 -> Bool) -> ByteString -> Bool maximum, -- :: ByteString -> Word8 minimum, -- :: ByteString -> Word8+ compareLength, -- :: ByteString -> Int64 -> Ordering -- * Building ByteStrings -- ** Scans@@ -178,6 +179,7 @@ -- * Zipping and unzipping ByteStrings zip, -- :: ByteString -> ByteString -> [(Word8,Word8)] zipWith, -- :: (Word8 -> Word8 -> c) -> ByteString -> ByteString -> [c]+ packZipWith, -- :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString -> ByteString unzip, -- :: [(Word8,Word8)] -> (ByteString,ByteString) -- * Ordered ByteStrings@@ -237,7 +239,6 @@ import System.IO.Error (mkIOError, illegalOperationErrorType) import System.IO.Unsafe -import Foreign.ForeignPtr (withForeignPtr) import Foreign.Ptr import Foreign.Storable @@ -265,11 +266,11 @@ -- | /O(c)/ Convert a list of strict 'ByteString' into a lazy 'ByteString' fromChunks :: [P.ByteString] -> ByteString-fromChunks cs = L.foldr chunk Empty cs+fromChunks = L.foldr chunk Empty -- | /O(c)/ Convert a lazy 'ByteString' into a list of strict 'ByteString' toChunks :: ByteString -> [P.ByteString]-toChunks cs = foldrChunks (:) [] cs+toChunks = foldrChunks (:) [] ------------------------------------------------------------------------ @@ -299,8 +300,8 @@ -- | /O(c)/ 'length' returns the length of a ByteString as an 'Int64' length :: ByteString -> Int64-length cs = foldlChunks (\n c -> n + fromIntegral (S.length c)) 0 cs-{-# INLINE length #-}+length = foldlChunks (\n c -> n + fromIntegral (S.length c)) 0+{-# INLINE [1] length #-} infixr 5 `cons`, `cons'` --same as list (:) infixl 5 `snoc`@@ -308,7 +309,7 @@ -- | /O(1)/ 'cons' is analogous to '(Prelude.:)' for lists. -- cons :: Word8 -> ByteString -> ByteString-cons c cs = Chunk (S.singleton c) cs+cons c = Chunk (S.singleton c) {-# INLINE cons #-} -- | /O(1)/ Unlike 'cons', 'cons'' is@@ -394,7 +395,7 @@ -- | /O(n)/ 'map' @f xs@ is the ByteString obtained by applying @f@ to each -- element of @xs@. map :: (Word8 -> Word8) -> ByteString -> ByteString-map f s = go s+map f = go where go Empty = Empty go (Chunk x xs) = Chunk y ys@@ -405,7 +406,7 @@ -- | /O(n)/ 'reverse' @xs@ returns the elements of @xs@ in reverse order. reverse :: ByteString -> ByteString-reverse cs0 = rev Empty cs0+reverse = rev Empty where rev a Empty = a rev a (Chunk c cs) = rev (Chunk (S.reverse c) a) cs {-# INLINE reverse #-}@@ -419,7 +420,7 @@ (foldrChunks (Chunk . intersperse') Empty cs) where intersperse' :: P.ByteString -> P.ByteString intersperse' (S.BS fp l) =- S.unsafeCreate (2*l) $ \p' -> withForeignPtr fp $ \p -> do+ S.unsafeCreate (2*l) $ \p' -> S.unsafeWithForeignPtr fp $ \p -> do poke p' w S.c_intersperse (p' `plusPtr` 1) p (fromIntegral l) w @@ -437,14 +438,14 @@ -- the left-identity of the operator), and a ByteString, reduces the -- ByteString using the binary operator, from left to right. foldl :: (a -> Word8 -> a) -> a -> ByteString -> a-foldl f z = go z+foldl f = go where go a Empty = a go a (Chunk c cs) = go (S.foldl f a c) cs {-# INLINE foldl #-} -- | 'foldl'' is like 'foldl', but strict in the accumulator. foldl' :: (a -> Word8 -> a) -> a -> ByteString -> a-foldl' f z = go z+foldl' f = go where go !a Empty = a go !a (Chunk c cs) = go (S.foldl' f a c) cs {-# INLINE foldl' #-}@@ -453,7 +454,7 @@ -- (typically the right-identity of the operator), and a ByteString, -- reduces the ByteString using the binary operator, from right to left. foldr :: (Word8 -> a -> a) -> a -> ByteString -> a-foldr k z = foldrChunks (flip (S.foldr k)) z+foldr k = foldrChunks (flip (S.foldr k)) {-# INLINE foldr #-} -- | 'foldl1' is a variant of 'foldl' that has no starting value@@ -500,14 +501,14 @@ -- | /O(n)/ Applied to a predicate and a ByteString, 'any' determines if -- any element of the 'ByteString' satisfies the predicate. any :: (Word8 -> Bool) -> ByteString -> Bool-any f cs = foldrChunks (\c rest -> S.any f c || rest) False cs+any f = foldrChunks (\c rest -> S.any f c || rest) False {-# INLINE any #-} -- todo fuse -- | /O(n)/ Applied to a predicate and a 'ByteString', 'all' determines -- if all elements of the 'ByteString' satisfy the predicate. all :: (Word8 -> Bool) -> ByteString -> Bool-all f cs = foldrChunks (\c rest -> S.all f c && rest) True cs+all f = foldrChunks (\c rest -> S.all f c && rest) True {-# INLINE all #-} -- todo fuse @@ -525,12 +526,54 @@ (S.minimum c) cs {-# INLINE minimum #-} +-- | /O(c)/ 'compareLength' compares the length of a 'ByteString'+-- to an 'Int64'+--+-- @since 0.11.1.0+compareLength :: ByteString -> Int64 -> Ordering+compareLength _ toCmp | toCmp < 0 = GT+compareLength Empty toCmp = compare 0 toCmp+compareLength (Chunk c cs) toCmp = compareLength cs (toCmp - fromIntegral (S.length c))+{-# INLINE compareLength #-}++{-# RULES+"ByteString.Lazy length/compareN -> compareLength" [~1] forall t n.+ compare (length t) n = compareLength t n+"ByteString.Lazy compareN/length -> compareLength" [~1] forall t n.+ -- compare EQ LT = GT and vice versa+ compare n (length t) = compare EQ $ compareLength t n+"ByteString.Lazy length/==N -> compareLength/==EQ" [~1] forall t n.+ length t == n = compareLength t n == EQ+"ByteString.Lazy N==/length -> compareLength/==EQ" [~1] forall t n.+ n == length t = compareLength t n == EQ+"ByteString.Lazy length//=N -> compareLength//=EQ" [~1] forall t n.+ length t /= n = compareLength t n /= EQ+"ByteString.Lazy N/=/length -> compareLength//=EQ" [~1] forall t n.+ n /= length t = compareLength t n /= EQ+"ByteString.Lazy length/<N -> compareLength/==LT" [~1] forall t n.+ length t < n = compareLength t n == LT+"ByteString.Lazy >N/length -> compareLength/==LT" [~1] forall t n.+ n > length t = compareLength t n == LT+"ByteString.Lazy length/<=N -> compareLength//=GT" [~1] forall t n.+ length t <= n = compareLength t n /= GT+"ByteString.Lazy <=N/length -> compareLength//=GT" [~1] forall t n.+ n >= length t = compareLength t n /= GT+"ByteString.Lazy length/>N -> compareLength/==GT" [~1] forall t n.+ length t > n = compareLength t n == GT+"ByteString.Lazy <N/length -> compareLength/==GT" [~1] forall t n.+ n < length t = compareLength t n == GT+"ByteString.Lazy length/>=N -> compareLength//=LT" [~1] forall t n.+ length t >= n = compareLength t n /= LT+"ByteString.Lazy >=N/length -> compareLength//=LT" [~1] forall t n.+ n <= length t = compareLength t n /= LT+ #-}+ -- | The 'mapAccumL' function behaves like a combination of 'map' and -- 'foldl'; it applies a function to each element of a ByteString, -- passing an accumulating parameter from left to right, and returning a -- final value of this accumulator together with the new ByteString. mapAccumL :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString)-mapAccumL f s0 = go s0+mapAccumL f = go where go s Empty = (s, Empty) go s (Chunk c cs) = (s'', Chunk c' cs')@@ -542,7 +585,7 @@ -- passing an accumulating parameter from right to left, and returning a -- final value of this accumulator together with the new ByteString. mapAccumR :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString)-mapAccumR f s0 = go s0+mapAccumR f = go where go s Empty = (s, Empty) go s (Chunk c cs) = (s'', Chunk c' cs')@@ -623,7 +666,7 @@ -- prepending to the ByteString and @b@ is used as the next element in a -- recursive call. unfoldr :: (a -> Maybe (Word8, a)) -> a -> ByteString-unfoldr f z = unfoldChunk 32 z+unfoldr f = unfoldChunk 32 where unfoldChunk n x = case S.unfoldrN n f x of (c, Nothing)@@ -676,10 +719,10 @@ -- returns the longest (possibly empty) prefix of elements -- satisfying the predicate. takeWhile :: (Word8 -> Bool) -> ByteString -> ByteString-takeWhile f cs0 = takeWhile' cs0+takeWhile f = takeWhile' where takeWhile' Empty = Empty takeWhile' (Chunk c cs) =- case findIndexOrEnd (not . f) c of+ case S.findIndexOrLength (not . f) c of 0 -> Empty n | n < S.length c -> Chunk (S.take n c) Empty | otherwise -> Chunk c (takeWhile' cs)@@ -688,10 +731,10 @@ -- drops the longest (possibly empty) prefix of elements -- satisfying the predicate and returns the remainder. dropWhile :: (Word8 -> Bool) -> ByteString -> ByteString-dropWhile f cs0 = dropWhile' cs0+dropWhile f = dropWhile' where dropWhile' Empty = Empty dropWhile' (Chunk c cs) =- case findIndexOrEnd (not . f) c of+ case S.findIndexOrLength (not . f) c of n | n < S.length c -> Chunk (S.drop n c) cs | otherwise -> dropWhile' cs @@ -702,10 +745,10 @@ -- 'break' @p@ is equivalent to @'span' (not . p)@ and to @('takeWhile' (not . p) &&& 'dropWhile' (not . p))@. -- break :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)-break f cs0 = break' cs0+break f = break' where break' Empty = (Empty, Empty) break' (Chunk c cs) =- case findIndexOrEnd f c of+ case S.findIndexOrLength f c of 0 -> (Empty, Chunk c cs) n | n < S.length c -> (Chunk (S.take n c) Empty ,Chunk (S.drop n c) cs)@@ -774,9 +817,9 @@ splitWith p (Chunk c0 cs0) = comb [] (S.splitWith p c0) cs0 where comb :: [P.ByteString] -> [P.ByteString] -> ByteString -> [ByteString]- comb acc (s:[]) Empty = revChunks (s:acc) : []- comb acc (s:[]) (Chunk c cs) = comb (s:acc) (S.splitWith p c) cs- comb acc (s:ss) cs = revChunks (s:acc) : comb [] ss cs+ comb acc [s] Empty = [revChunks (s:acc)]+ comb acc [s] (Chunk c cs) = comb (s:acc) (S.splitWith p c) cs+ comb acc (s:ss) cs = revChunks (s:acc) : comb [] ss cs {-# INLINE splitWith #-} -- | /O(n)/ Break a 'ByteString' into pieces separated by the byte@@ -801,8 +844,8 @@ split w (Chunk c0 cs0) = comb [] (S.split w c0) cs0 where comb :: [P.ByteString] -> [P.ByteString] -> ByteString -> [ByteString]- comb acc (s:[]) Empty = revChunks (s:acc) : []- comb acc (s:[]) (Chunk c cs) = comb (s:acc) (S.split w c) cs+ comb acc [s] Empty = [revChunks (s:acc)]+ comb acc [s] (Chunk c cs) = comb (s:acc) (S.split w c) cs comb acc (s:ss) cs = revChunks (s:acc) : comb [] ss cs {-# INLINE split #-} @@ -823,9 +866,9 @@ | S.length c == 1 = to [c] (S.unsafeHead c) cs | otherwise = to [S.unsafeTake 1 c] (S.unsafeHead c) (Chunk (S.unsafeTail c) cs) - to acc !_ Empty = revNonEmptyChunks acc : []+ to acc !_ Empty = [revNonEmptyChunks acc] to acc !w (Chunk c cs) =- case findIndexOrEnd (/= w) c of+ case S.findIndexOrLength (/= w) c of 0 -> revNonEmptyChunks acc : go (Chunk c cs) n | n == S.length c -> to (S.unsafeTake n c : acc) w cs@@ -842,9 +885,9 @@ | S.length c == 1 = to [c] (S.unsafeHead c) cs | otherwise = to [S.unsafeTake 1 c] (S.unsafeHead c) (Chunk (S.unsafeTail c) cs) - to acc !_ Empty = revNonEmptyChunks acc : []+ to acc !_ Empty = [revNonEmptyChunks acc] to acc !w (Chunk c cs) =- case findIndexOrEnd (not . k w) c of+ case S.findIndexOrLength (not . k w) c of 0 -> revNonEmptyChunks acc : go (Chunk c cs) n | n == S.length c -> to (S.unsafeTake n c : acc) w cs@@ -898,7 +941,7 @@ -- element, or 'Nothing' if there is no such element. -- This implementation uses memchr(3). elemIndex :: Word8 -> ByteString -> Maybe Int64-elemIndex w cs0 = elemIndex' 0 cs0+elemIndex w = elemIndex' 0 where elemIndex' _ Empty = Nothing elemIndex' n (Chunk c cs) = case S.elemIndex w c of@@ -910,8 +953,9 @@ -- element, or 'Nothing' if there is no such element. The following -- holds: ----- > elemIndexEnd c xs ==--- > (-) (length xs - 1) `fmap` elemIndex c (reverse xs)+-- > elemIndexEnd c xs = case elemIndex c (reverse xs) of+-- > Nothing -> Nothing+-- > Just i -> Just (length xs - 1 - i) -- -- @since 0.10.6.0 elemIndexEnd :: Word8 -> ByteString -> Maybe Int64@@ -922,7 +966,7 @@ -- the indices of all elements equal to the query element, in ascending order. -- This implementation uses memchr(3). elemIndices :: Word8 -> ByteString -> [Int64]-elemIndices w cs0 = elemIndices' 0 cs0+elemIndices w = elemIndices' 0 where elemIndices' _ Empty = [] elemIndices' n (Chunk c cs) = L.map ((+n).fromIntegral) (S.elemIndices w c) ++ elemIndices' (n + fromIntegral (S.length c)) cs@@ -933,13 +977,13 @@ -- -- But more efficiently than using length on the intermediate list. count :: Word8 -> ByteString -> Int64-count w cs = foldlChunks (\n c -> n + fromIntegral (S.count w c)) 0 cs+count w = foldlChunks (\n c -> n + fromIntegral (S.count w c)) 0 -- | The 'findIndex' function takes a predicate and a 'ByteString' and -- returns the index of the first element in the ByteString -- satisfying the predicate. findIndex :: (Word8 -> Bool) -> ByteString -> Maybe Int64-findIndex k cs0 = findIndex' 0 cs0+findIndex k = findIndex' 0 where findIndex' _ Empty = Nothing findIndex' n (Chunk c cs) = case S.findIndex k c of@@ -958,7 +1002,7 @@ findIndexEnd' _ Empty = Nothing findIndexEnd' n (Chunk c cs) = let !n' = n + S.length c- !i = fmap (fromIntegral . (n +)) $ S.findIndexEnd k c+ !i = fromIntegral . (n +) <$> S.findIndexEnd k c in findIndexEnd' n' cs `mplus` i {-# INLINE findIndexEnd #-} @@ -969,7 +1013,7 @@ -- > find f p = case findIndex f p of Just n -> Just (p ! n) ; _ -> Nothing -- find :: (Word8 -> Bool) -> ByteString -> Maybe Word8-find f cs0 = find' cs0+find f = find' where find' Empty = Nothing find' (Chunk c cs) = case S.find f c of Nothing -> find' cs@@ -979,7 +1023,7 @@ -- | The 'findIndices' function extends 'findIndex', by returning the -- indices of all elements satisfying the predicate, in ascending order. findIndices :: (Word8 -> Bool) -> ByteString -> [Int64]-findIndices k cs0 = findIndices' 0 cs0+findIndices k = findIndices' 0 where findIndices' _ Empty = [] findIndices' n (Chunk c cs) = L.map ((+n).fromIntegral) (S.findIndices k c) ++ findIndices' (n + fromIntegral (S.length c)) cs@@ -994,13 +1038,13 @@ -- | /O(n)/ 'notElem' is the inverse of 'elem' notElem :: Word8 -> ByteString -> Bool-notElem w cs = not (elem w cs)+notElem w cs = not (w `elem` cs) -- | /O(n)/ 'filter', applied to a predicate and a ByteString, -- returns a ByteString containing those characters that satisfy the -- predicate. filter :: (Word8 -> Bool) -> ByteString -> ByteString-filter p s = go s+filter p = go where go Empty = Empty go (Chunk x xs) = chunk (S.filter p x) (go xs)@@ -1131,6 +1175,20 @@ to _ (Chunk x' xs) y ys | not (S.null y) = go x' xs y ys to _ (Chunk x' xs) _ (Chunk y' ys) = go x' xs y' ys +-- | A specialised version of `zipWith` for the common case of a+-- simultaneous map over two ByteStrings, to build a 3rd.+--+-- @since 0.11.1.0+packZipWith :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString -> ByteString+packZipWith _ Empty _ = Empty+packZipWith _ _ Empty = Empty+packZipWith f (Chunk a@(S.BS _ al) as) (Chunk b@(S.BS _ bl) bs) = Chunk (S.packZipWith f a b) $+ case compare al bl of+ LT -> packZipWith f as $ Chunk (S.drop al b) bs+ EQ -> packZipWith f as bs+ GT -> packZipWith f (Chunk (S.drop bl a) as) bs+{-# INLINE packZipWith #-}+ -- | /O(n)/ 'unzip' transforms a list of pairs of bytes into a pair of -- ByteStrings. Note that this performs two 'pack' operations. unzip :: [(Word8,Word8)] -> (ByteString,ByteString)@@ -1149,7 +1207,7 @@ -- | /O(n)/ Return all final segments of the given 'ByteString', longest first. tails :: ByteString -> [ByteString]-tails Empty = Empty : []+tails Empty = [Empty] tails cs@(Chunk c cs') | S.length c == 1 = cs : tails cs' | otherwise = cs : tails (Chunk (S.unsafeTail c) cs')@@ -1163,7 +1221,7 @@ -- if a large string has been read in, and only a small part of it -- is needed in the rest of the program. copy :: ByteString -> ByteString-copy cs = foldrChunks (Chunk . S.copy) Empty cs+copy = foldrChunks (Chunk . S.copy) Empty --TODO, we could coalese small blocks here --FIXME: probably not strict enough, if we're doing this to avoid retaining -- the parent blocks then we'd better copy strictly.@@ -1187,10 +1245,6 @@ -- -- The handle is closed on EOF. ----- Note: the 'Handle' should be placed in binary mode with--- 'System.IO.hSetBinaryMode' for 'hGetContentsN' to--- work correctly.--- hGetContentsN :: Int -> Handle -> IO ByteString hGetContentsN k h = lazyRead -- TODO close on exceptions where@@ -1200,8 +1254,7 @@ c <- S.hGetSome h k -- only blocks if there is no data available if S.null c then hClose h >> return Empty- else do cs <- lazyRead- return (Chunk c cs)+ else Chunk c <$> lazyRead -- | Read @n@ bytes into a 'ByteString', directly from the -- specified 'Handle', in chunks of size @k@.@@ -1249,10 +1302,6 @@ -- File handles are closed on EOF if all the file is read, or through -- garbage collection otherwise. ----- Note: the 'Handle' should be placed in binary mode with--- 'System.IO.hSetBinaryMode' for 'hGetContents' to--- work correctly.--- hGetContents :: Handle -> IO ByteString hGetContents = hGetContentsN defaultChunkSize @@ -1305,7 +1354,7 @@ -- writes, and hence 'hPut' alone might not be suitable for concurrent writes. -- hPut :: Handle -> ByteString -> IO ()-hPut h cs = foldrChunks (\c rest -> S.hPut h c >> rest) (return ()) cs+hPut h = foldrChunks (\c rest -> S.hPut h c >> rest) (return ()) -- | Similar to 'hPut' except that it will never block. Instead it returns -- any tail that did not get written. This tail may be 'empty' in the case that@@ -1357,25 +1406,11 @@ -- reverse a list of non-empty chunks into a lazy ByteString revNonEmptyChunks :: [P.ByteString] -> ByteString-revNonEmptyChunks cs = L.foldl' (flip Chunk) Empty cs+revNonEmptyChunks = L.foldl' (flip Chunk) Empty -- reverse a list of possibly-empty chunks into a lazy ByteString revChunks :: [P.ByteString] -> ByteString-revChunks cs = L.foldl' (flip chunk) Empty cs---- | 'findIndexOrEnd' is a variant of findIndex, that returns the length--- of the string if no element is found, rather than Nothing.-findIndexOrEnd :: (Word8 -> Bool) -> P.ByteString -> Int-findIndexOrEnd k (S.BS x l) =- S.accursedUnutterablePerformIO $- withForeignPtr x $ \f -> go f 0- where- go !ptr !n | n >= l = return l- | otherwise = do w <- peek ptr- if k w- then return n- else go (ptr `plusPtr` 1) (n+1)-{-# INLINE findIndexOrEnd #-}+revChunks = L.foldl' (flip chunk) Empty -- $IOChunk --
Data/ByteString/Lazy/Char8.hs view
@@ -81,6 +81,7 @@ all, -- :: (Char -> Bool) -> ByteString -> Bool maximum, -- :: ByteString -> Char minimum, -- :: ByteString -> Char+ compareLength, -- :: ByteString -> Int -> Ordering -- * Building ByteStrings -- ** Scans@@ -149,15 +150,18 @@ indexMaybe, -- :: ByteString -> Int64 -> Maybe Char (!?), -- :: ByteString -> Int64 -> Maybe Char elemIndex, -- :: Char -> ByteString -> Maybe Int64+ elemIndexEnd, -- :: Char -> ByteString -> Maybe Int64 elemIndices, -- :: Char -> ByteString -> [Int64] findIndex, -- :: (Char -> Bool) -> ByteString -> Maybe Int64+ findIndexEnd, -- :: (Char -> Bool) -> ByteString -> Maybe Int64 findIndices, -- :: (Char -> Bool) -> ByteString -> [Int64] count, -- :: Char -> ByteString -> Int64 -- * Zipping and unzipping ByteStrings zip, -- :: ByteString -> ByteString -> [(Char,Char)] zipWith, -- :: (Char -> Char -> c) -> ByteString -> ByteString -> [c]--- unzip, -- :: [(Char,Char)] -> (ByteString,ByteString)+ packZipWith, -- :: (Char -> Char -> Char) -> ByteString -> ByteString -> ByteString+ unzip, -- :: [(Char,Char)] -> (ByteString,ByteString) -- * Ordered ByteStrings -- sort, -- :: ByteString -> ByteString@@ -207,7 +211,7 @@ ,hGetContents, hGet, hPut, getContents ,hGetNonBlocking, hPutNonBlocking ,putStr, hPutStr, interact- ,readFile,writeFile,appendFile)+ ,readFile,writeFile,appendFile,compareLength) -- Functions we need to wrap. import qualified Data.ByteString.Lazy as L@@ -218,6 +222,10 @@ import Data.ByteString.Internal (w2c, c2w, isSpaceWord8) +#if !(MIN_VERSION_base(4,8,0))+import Control.Applicative ((<$>))+#endif+ import Data.Int (Int64) import qualified Data.List as List @@ -330,7 +338,7 @@ -- (typically the right-identity of the operator), and a packed string, -- reduces the packed string using the binary operator, from right to left. foldr :: (Char -> a -> a) -> a -> ByteString -> a-foldr f = L.foldr (\c a -> f (w2c c) a)+foldr f = L.foldr (f . w2c) {-# INLINE foldr #-} -- | 'foldl1' is a variant of 'foldl' that has no starting value@@ -556,6 +564,20 @@ elemIndex = L.elemIndex . c2w {-# INLINE elemIndex #-} +-- | /O(n)/ The 'elemIndexEnd' function returns the last index of the+-- element in the given 'ByteString' which is equal to the query+-- element, or 'Nothing' if there is no such element. The following+-- holds:+--+-- > elemIndexEnd c xs = case elemIndex c (reverse xs) of+-- > Nothing -> Nothing+-- > Just i -> Just (length xs - 1 - i)+--+-- @since 0.11.1.0+elemIndexEnd :: Char -> ByteString -> Maybe Int64+elemIndexEnd = L.elemIndexEnd . c2w+{-# INLINE elemIndexEnd #-}+ -- | /O(n)/ The 'elemIndices' function extends 'elemIndex', by returning -- the indices of all elements equal to the query element, in ascending order. elemIndices :: Char -> ByteString -> [Int64]@@ -568,6 +590,15 @@ findIndex f = L.findIndex (f . w2c) {-# INLINE findIndex #-} +-- | The 'findIndexEnd' function takes a predicate and a 'ByteString' and+-- returns the index of the last element in the ByteString+-- satisfying the predicate.+--+-- @since 0.11.1.0+findIndexEnd :: (Char -> Bool) -> ByteString -> Maybe Int64+findIndexEnd f = L.findIndexEnd (f . w2c)+{-# INLINE findIndexEnd #-}+ -- | The 'findIndices' function extends 'findIndex', by returning the -- indices of all elements satisfying the predicate, in ascending order. findIndices :: (Char -> Bool) -> ByteString -> [Int64]@@ -683,6 +714,24 @@ zipWith :: (Char -> Char -> a) -> ByteString -> ByteString -> [a] zipWith f = L.zipWith ((. w2c) . f . w2c) +-- | A specialised version of `zipWith` for the common case of a+-- simultaneous map over two ByteStrings, to build a 3rd.+--+-- @since 0.11.1.0+packZipWith :: (Char -> Char -> Char) -> ByteString -> ByteString -> ByteString+packZipWith f = L.packZipWith f'+ where+ f' c1 c2 = c2w $ f (w2c c1) (w2c c2)+{-# INLINE packZipWith #-}++-- | /O(n)/ 'unzip' transforms a list of pairs of chars into a pair of+-- ByteStrings. Note that this performs two 'pack' operations.+--+-- @since 0.11.1.0+unzip :: [(Char, Char)] -> (ByteString, ByteString)+unzip ls = (pack (fmap fst ls), pack (fmap snd ls))+{-# INLINE unzip #-}+ -- | 'lines' breaks a ByteString up into a list of ByteStrings at -- newline Chars (@'\\n'@). The resulting strings do not contain newlines. --@@ -710,8 +759,8 @@ loop0 c cs = case B.elemIndex (c2w '\n') c of Nothing -> case cs of- Empty | B.null c -> []- | otherwise -> Chunk c Empty : []+ Empty | B.null c -> []+ | otherwise -> [Chunk c Empty] (Chunk c' cs') | B.null c -> loop0 c' cs' | otherwise -> loop c' [c] cs'@@ -728,38 +777,14 @@ case B.elemIndex (c2w '\n') c of Nothing -> case cs of- Empty -> let c' = revChunks (c : line)- in c' `seq` (c' : [])+ Empty -> let !c' = revChunks (c : line)+ in [c'] (Chunk c' cs') -> loop c' (c : line) cs' Just n ->- let c' = revChunks (B.unsafeTake n c : line)- in c' `seq` (c' : loop0 (B.unsafeDrop (n+1) c) cs)--{---This function is too strict! Consider,--> prop_lazy =- (L.unpack . head . lazylines $ L.append (L.pack "a\nb\n") (error "failed"))- ==- "a"--fails. Here's a properly lazy version of 'lines' for lazy bytestrings-- lazylines :: L.ByteString -> [L.ByteString]- lazylines s- | L.null s = []- | otherwise =- let (l,s') = L.break ((==) '\n') s- in l : if L.null s' then []- else lazylines (L.tail s')--we need a similarly lazy, but efficient version.---}-+ let !c' = revChunks (B.unsafeTake n c : line)+ in c' : loop0 (B.unsafeDrop (n+1) c) cs -- | 'unlines' is an inverse operation to 'lines'. It joins lines, -- after appending a terminating newline to each.@@ -819,7 +844,6 @@ e = n' `seq` c' `seq` Just (n',c') -- in n' `seq` c' `seq` JustS n' c' - -- | readInteger reads an Integer from the beginning of the ByteString. If -- there is no integer at the beginning of the string, it returns Nothing, -- otherwise it just returns the int read, and the rest of the string.@@ -866,11 +890,11 @@ combine1 _ [n] = n combine1 b ns = combine1 (b*b) $ combine2 b ns - combine2 b (n:m:ns) = let t = n+m*b in t `seq` (t : combine2 b ns)+ combine2 b (n:m:ns) = let !t = n+m*b in t : combine2 b ns combine2 _ ns = ns - end n c cs = let c' = chunk c cs- in c' `seq` (n, c')+ end n c cs = let !c' = chunk c cs+ in (n, c') -- | Write a ByteString to a handle, appending a newline byte@@ -888,4 +912,4 @@ -- reverse a list of possibly-empty chunks into a lazy ByteString revChunks :: [S.ByteString] -> ByteString-revChunks cs = List.foldl' (flip chunk) Empty cs+revChunks = List.foldl' (flip chunk) Empty
Data/ByteString/Lazy/Internal.hs view
@@ -57,10 +57,10 @@ import Foreign.Storable (Storable(sizeOf)) #if MIN_VERSION_base(4,13,0)-import Data.Semigroup (Semigroup (sconcat))+import Data.Semigroup (Semigroup (sconcat, stimes)) import Data.List.NonEmpty (NonEmpty ((:|))) #elif MIN_VERSION_base(4,9,0)-import Data.Semigroup (Semigroup ((<>), sconcat))+import Data.Semigroup (Semigroup ((<>), sconcat, stimes)) import Data.List.NonEmpty (NonEmpty ((:|))) #endif #if !(MIN_VERSION_base(4,8,0))@@ -98,6 +98,7 @@ instance Semigroup ByteString where (<>) = append sconcat (b:|bs) = concat (b:bs)+ stimes = times #endif instance Monoid ByteString where@@ -142,6 +143,7 @@ -- Packing and unpacking from lists packBytes :: [Word8] -> ByteString+packBytes [] = Empty packBytes cs0 = packChunks 32 cs0 where@@ -150,6 +152,7 @@ (bs, cs') -> Chunk bs (packChunks (min (n * 2) smallChunkSize) cs') packChars :: [Char] -> ByteString+packChars [] = Empty packChars cs0 = packChunks 32 cs0 where packChunks n cs = case S.packUptoLenChars n cs of@@ -200,10 +203,9 @@ -- | Consume the chunks of a lazy ByteString with a strict, tail-recursive, -- accumulating left fold. foldlChunks :: (a -> S.ByteString -> a) -> a -> ByteString -> a-foldlChunks f z = go z- where go a _ | a `seq` False = undefined- go a Empty = a- go a (Chunk c cs) = go (f a c) cs+foldlChunks f = go+ where go !a Empty = a+ go !a (Chunk c cs) = go (f a c) cs {-# INLINE foldlChunks #-} ------------------------------------------------------------------------@@ -266,13 +268,27 @@ append xs ys = foldrChunks Chunk ys xs concat :: [ByteString] -> ByteString-concat css0 = to css0+concat = to where go Empty css = to css go (Chunk c cs) css = Chunk c (go cs css) to [] = Empty to (cs:css) = go cs css +#if MIN_VERSION_base(4,9,0)+-- | Repeats the given ByteString n times.+times :: Integral a => a -> ByteString -> ByteString+times 0 _ = Empty+times n lbs0+ | n < 0 = error "stimes: non-negative multiplier expected"+ | otherwise = case lbs0 of+ Empty -> Empty+ Chunk bs lbs -> Chunk bs (go lbs)+ where+ go Empty = times (n-1) lbs0+ go (Chunk c cs) = Chunk c (go cs)+#endif+ ------------------------------------------------------------------------ -- Conversions @@ -314,7 +330,7 @@ -- Copy the data goCopy Empty !_ = return () goCopy (Chunk (S.BS _ 0 ) cs) !ptr = goCopy cs ptr- goCopy (Chunk (S.BS fp len) cs) !ptr = do+ goCopy (Chunk (S.BS fp len) cs) !ptr = withForeignPtr fp $ \p -> do S.memcpy ptr p len goCopy cs (ptr `plusPtr` len)
Data/ByteString/Short.hs view
@@ -30,7 +30,7 @@ -- * The @ShortByteString@ type - ShortByteString,+ ShortByteString(..), -- ** Memory overhead -- | With GHC, the memory overheads are as follows, expressed in words and
Data/ByteString/Short/Internal.hs view
@@ -86,9 +86,11 @@ , byteArrayContents# , unsafeCoerce# #endif-#if MIN_VERSION_base(4,3,0)- , sizeofByteArray#+#if MIN_VERSION_base(4,10,0)+ , isByteArrayPinned#+ , isTrue# #endif+ , sizeofByteArray# , indexWord8Array#, indexCharArray# , writeWord8Array#, writeCharArray# , unsafeFreezeByteArray# )@@ -109,7 +111,6 @@ , return , Maybe(..) ) - -- | A compact representation of a 'Word8' vector. -- -- It has a lower memory overhead than a 'ByteString' and does not@@ -124,16 +125,6 @@ -- more flexible and it supports a wide range of operations. -- data ShortByteString = SBS ByteArray#-#if !(MIN_VERSION_base(4,3,0))- {-# UNPACK #-} !Int -- ^ Prior to ghc-7.0.x, 'ByteArray#'s reported- -- their length rounded up to the nearest word.- -- This means we have to store the true length- -- separately, wasting a word.-#define LEN(x) (x)-#else-#define _len /* empty */-#define LEN(x) /* empty */-#endif deriving Typeable -- The ByteArray# representation is always word sized and aligned but with a@@ -199,11 +190,7 @@ -- | /O(1)/ The length of a 'ShortByteString'. length :: ShortByteString -> Int-#if MIN_VERSION_base(4,3,0) length (SBS barr#) = I# (sizeofByteArray# barr#)-#else-length (SBS _ len) = len-#endif -- | /O(1)/ Test whether a 'ShortByteString' is empty. null :: ShortByteString -> Bool@@ -248,15 +235,15 @@ -- Internal utils asBA :: ShortByteString -> BA-asBA (SBS ba# _len) = BA# ba#+asBA (SBS ba#) = BA# ba# create :: Int -> (forall s. MBA s -> ST s ()) -> ShortByteString create len fill =- runST (do+ runST $ do mba <- newByteArray len fill mba BA# ba# <- unsafeFreezeByteArray mba- return (SBS ba# LEN(len)))+ return (SBS ba#) {-# INLINE create #-} ------------------------------------------------------------------------@@ -276,12 +263,20 @@ stToIO (copyAddrToByteArray ptr mba 0 len) touchForeignPtr fptr BA# ba# <- stToIO (unsafeFreezeByteArray mba)- return (SBS ba# LEN(len))+ return (SBS ba#) -- | /O(n)/. Convert a 'ShortByteString' into a 'ByteString'. -- fromShort :: ShortByteString -> ByteString+#if MIN_VERSION_base(4,10,0)+fromShort (SBS b#)+ | isTrue# (isByteArrayPinned# b#) = BS fp len+ where+ addr# = byteArrayContents# b#+ fp = ForeignPtr addr# (PlainPtr (unsafeCoerce# b#))+ len = I# (sizeofByteArray# b#)+#endif fromShort !sbs = unsafeDupablePerformIO (fromShortIO sbs) fromShortIO :: ShortByteString -> IO ByteString@@ -364,7 +359,7 @@ -- (5 words per list element, 8 bytes per word, 100 elements = 4000 bytes) unpackAppendCharsLazy :: ShortByteString -> [Char] -> [Char]-unpackAppendCharsLazy sbs cs0 = go 0 (length sbs) cs0+unpackAppendCharsLazy sbs = go 0 (length sbs) where sz = 100 @@ -374,7 +369,7 @@ where remainder = go (off+sz) (len-sz) cs unpackAppendBytesLazy :: ShortByteString -> [Word8] -> [Word8]-unpackAppendBytesLazy sbs ws0 = go 0 (length sbs) ws0+unpackAppendBytesLazy sbs = go 0 (length sbs) where sz = 100 @@ -389,7 +384,7 @@ -- buffer and loops down until we hit the sentinal: unpackAppendCharsStrict :: ShortByteString -> Int -> Int -> [Char] -> [Char]-unpackAppendCharsStrict !sbs off len cs = go (off-1) (off-1 + len) cs+unpackAppendCharsStrict !sbs off len = go (off-1) (off-1 + len) where go !sentinal !i !acc | i == sentinal = acc@@ -397,7 +392,7 @@ in go sentinal (i-1) (c:acc) unpackAppendBytesStrict :: ShortByteString -> Int -> Int -> [Word8] -> [Word8]-unpackAppendBytesStrict !sbs off len ws = go (off-1) (off-1 + len) ws+unpackAppendBytesStrict !sbs off len = go (off-1) (off-1 + len) where go !sentinal !i !acc | i == sentinal = acc@@ -476,7 +471,7 @@ mba <- newByteArray len copyAddrToByteArray ptr mba 0 len BA# ba# <- unsafeFreezeByteArray mba- return (SBS ba# LEN(len))+ return (SBS ba#) ------------------------------------------------------------------------@@ -572,13 +567,13 @@ #else -copyAddrToByteArray# src dst dst_off len s =- unIO_ (memcpy_AddrToByteArray dst (csize dst_off) src 0 (csize len)) s+copyAddrToByteArray# src dst dst_off len =+ unIO_ (memcpy_AddrToByteArray dst (csize dst_off) src 0 (csize len)) copyAddrToByteArray0 :: Addr# -> MutableByteArray# s -> Int# -> State# RealWorld -> State# RealWorld-copyAddrToByteArray0 src dst len s =- unIO_ (memcpy_AddrToByteArray0 dst src (csize len)) s+copyAddrToByteArray0 src dst len =+ unIO_ (memcpy_AddrToByteArray0 dst src (csize len)) {-# INLINE [0] copyAddrToByteArray# #-} {-# RULES "copyAddrToByteArray# dst_off=0"@@ -593,13 +588,13 @@ memcpy_AddrToByteArray0 :: MutableByteArray# s -> Addr# -> CSize -> IO () -copyByteArrayToAddr# src src_off dst len s =- unIO_ (memcpy_ByteArrayToAddr dst 0 src (csize src_off) (csize len)) s+copyByteArrayToAddr# src src_off dst len =+ unIO_ (memcpy_ByteArrayToAddr dst 0 src (csize src_off) (csize len)) copyByteArrayToAddr0 :: ByteArray# -> Addr# -> Int# -> State# RealWorld -> State# RealWorld-copyByteArrayToAddr0 src dst len s =- unIO_ (memcpy_ByteArrayToAddr0 dst src (csize len)) s+copyByteArrayToAddr0 src dst len =+ unIO_ (memcpy_ByteArrayToAddr0 dst src (csize len)) {-# INLINE [0] copyByteArrayToAddr# #-} {-# RULES "copyByteArrayToAddr# src_off=0"
README.md view
@@ -1,6 +1,6 @@ # ByteString: Fast, Packed Strings of Bytes -[](http://travis-ci.org/haskell/bytestring) [](https://hackage.haskell.org/package/bytestring) [](https://matrix.hackage.haskell.org/package/bytestring) [](http://stackage.org/lts/package/bytestring) [](http://stackage.org/nightly/package/bytestring)+[](https://github.com/haskell/bytestring/actions?query=workflow%3Aci) [](https://hackage.haskell.org/package/bytestring) [](https://matrix.hackage.haskell.org/package/bytestring) [](http://stackage.org/lts/package/bytestring) [](http://stackage.org/nightly/package/bytestring) This library provides the `Data.ByteString` module -- strict and lazy byte arrays manipulable as strings -- providing very time/space-efficient
+ bench/BenchAll.hs view
@@ -0,0 +1,453 @@+-- |+-- Copyright : (c) 2011 Simon Meier+-- License : BSD3-style (see LICENSE)+--+-- Maintainer : Simon Meier <iridcode@gmail.com>+-- Stability : experimental+-- Portability : tested on GHC only+--++{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE MagicHash #-}++module Main (main) where++import Data.Foldable (foldMap)+import Data.Monoid+import Data.String+import Test.Tasty.Bench+import Prelude hiding (words)++import qualified Data.ByteString as S+import qualified Data.ByteString.Char8 as S8+import qualified Data.ByteString.Lazy as L++import Data.ByteString.Builder+import Data.ByteString.Builder.Extra (byteStringCopy,+ byteStringInsert,+ intHost)+import Data.ByteString.Builder.Internal (ensureFree)+import Data.ByteString.Builder.Prim (BoundedPrim, FixedPrim,+ (>$<))+import qualified Data.ByteString.Builder.Prim as P+import qualified Data.ByteString.Builder.Prim.Internal as PI++import Foreign++import System.Random++import BenchBoundsCheckFusion+import BenchCSV+import BenchIndices++------------------------------------------------------------------------------+-- Benchmark support+------------------------------------------------------------------------------++countToZero :: Int -> Maybe (Int, Int)+countToZero 0 = Nothing+countToZero n = Just (n, n - 1)+++------------------------------------------------------------------------------+-- Benchmark+------------------------------------------------------------------------------++-- input data (NOINLINE to ensure memoization)+----------------------------------------------++-- | Few-enough repetitions to avoid making GC too expensive.+nRepl :: Int+nRepl = 10000++{-# NOINLINE intData #-}+intData :: [Int]+intData = [1..nRepl]++{-# NOINLINE smallIntegerData #-}+smallIntegerData :: [Integer]+smallIntegerData = map fromIntegral intData++{-# NOINLINE largeIntegerData #-}+largeIntegerData :: [Integer]+largeIntegerData = map (* (10 ^ (100 :: Integer))) smallIntegerData+++{-# NOINLINE floatData #-}+floatData :: [Float]+floatData = map (\x -> (3.14159 * fromIntegral x) ^ (3 :: Int)) intData++{-# NOINLINE doubleData #-}+doubleData :: [Double]+doubleData = map (\x -> (3.14159 * fromIntegral x) ^ (3 :: Int)) intData++{-# NOINLINE byteStringData #-}+byteStringData :: S.ByteString+byteStringData = S.pack $ map fromIntegral intData++{-# NOINLINE lazyByteStringData #-}+lazyByteStringData :: L.ByteString+lazyByteStringData = case S.splitAt (nRepl `div` 2) byteStringData of+ (bs1, bs2) -> L.fromChunks [bs1, bs2]++{-# NOINLINE byteStringChunksData #-}+byteStringChunksData :: [S.ByteString]+byteStringChunksData = map (S.pack . replicate (4 ) . fromIntegral) intData++{-# NOINLINE loremIpsum #-}+loremIpsum :: S.ByteString+loremIpsum = S8.unlines $ map S8.pack+ [ " Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor"+ , "incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis"+ , "nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat."+ , "Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu"+ , "fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in"+ , "culpa qui officia deserunt mollit anim id est laborum."+ ]++-- benchmark wrappers+---------------------++{-# INLINE benchB #-}+benchB :: String -> a -> (a -> Builder) -> Benchmark+benchB name x b =+ bench (name ++" (" ++ show nRepl ++ ")") $+ whnf (L.length . toLazyByteString . b) x++{-# INLINE benchB' #-}+benchB' :: String -> a -> (a -> Builder) -> Benchmark+benchB' name x b = bench name $ whnf (L.length . toLazyByteString . b) x++{-# INLINE benchBInts #-}+benchBInts :: String -> ([Int] -> Builder) -> Benchmark+benchBInts name = benchB name intData++-- | Benchmark a 'FixedPrim'. Full inlining to enable specialization.+{-# INLINE benchFE #-}+benchFE :: String -> FixedPrim Int -> Benchmark+benchFE name = benchBE name . P.liftFixedToBounded++-- | Benchmark a 'BoundedPrim'. Full inlining to enable specialization.+{-# INLINE benchBE #-}+benchBE :: String -> BoundedPrim Int -> Benchmark+benchBE name e =+ bench (name ++" (" ++ show nRepl ++ ")") $ whnfIO (benchIntEncodingB nRepl e)++-- We use this construction of just looping through @n,n-1,..,1@ to ensure that+-- we measure the speed of the encoding and not the speed of generating the+-- values to be encoded.+{-# INLINE benchIntEncodingB #-}+benchIntEncodingB :: Int -- ^ Maximal 'Int' to write+ -> BoundedPrim Int -- ^ 'BoundedPrim' to execute+ -> IO () -- ^ 'IO' action to benchmark+benchIntEncodingB n0 w+ | n0 <= 0 = return ()+ | otherwise = do+ fpbuf <- mallocForeignPtrBytes (n0 * PI.sizeBound w)+ withForeignPtr fpbuf (loop n0) >> return ()+ where+ loop !n !op+ | n <= 0 = return op+ | otherwise = PI.runB w n op >>= loop (n - 1)++hashInt :: Int -> Int+hashInt x = iterate step x !! 10+ where+ step a = e+ where b = (a `xor` 61) `xor` (a `shiftR` 16)+ c = b + (b `shiftL` 3)+ d = c `xor` (c `shiftR` 4)+ e = d * 0x27d4eb2d+ f = e `xor` (e `shiftR` 15)++w :: Int -> Word8+w = fromIntegral++hashWord8 :: Word8 -> Word8+hashWord8 = fromIntegral . hashInt . fromIntegral++partitionStrict p = nf (S.partition p) . randomStrict $ mkStdGen 98423098+ where randomStrict = fst . S.unfoldrN 10000 (Just . random)++partitionLazy p = nf (L.partition p) . randomLazy $ (0, mkStdGen 98423098)+ where step (k, g)+ | k >= 10000 = Nothing+ | otherwise = let (x, g') = random g in Just (x, (k + 1, g'))+ randomLazy = L.unfoldr step++easySubstrings, randomSubstrings :: Int -> Int -> (S.ByteString, S.ByteString)+hardSubstrings, pathologicalSubstrings :: Int ->+ Int -> (S.ByteString, S.ByteString)++{-# INLINE easySubstrings #-}+easySubstrings n h = (S.replicate n $ w 1,+ S.replicate h $ w 0)++{-# INLINE randomSubstrings #-}+randomSubstrings n h = (f 48278379 n, f 98403980 h)+ where+ next' g = let (x, g') = next g in (w x, g')+ f g l = fst $ S.unfoldrN l (Just . next') (mkStdGen g)++{-# INLINE hardSubstrings #-}+hardSubstrings n h = (f 48278379 n, f 98403980 h)+ where+ next' g = let (x, g') = next g+ in (w $ x `mod` 4, g')+ f g l = fst $ S.unfoldrN l (Just . next') (mkStdGen g)++{-# INLINE pathologicalSubstrings #-}+pathologicalSubstrings n h =+ (S.replicate n (w 0),+ S.concat . replicate (h `div` n) $ S.replicate (n - 1) (w 0) `S.snoc` w 1)++htmlSubstrings :: S.ByteString -> Int -> Int -> IO (S.ByteString, S.ByteString)+htmlSubstrings s n h =+ do i <- randomRIO (0, l - n)+ return (S.take n . S.drop i $ s', s')+ where+ s' = S.take h s+ l = S.length s'++-- benchmarks+-------------++sanityCheckInfo :: [String]+sanityCheckInfo =+ [ "Sanity checks:"+ , " lengths of input data: " ++ show+ [ length intData, length floatData, length doubleData+ , length smallIntegerData, length largeIntegerData+ , S.length byteStringData, fromIntegral (L.length lazyByteStringData)+ ]+ ]++sortInputs :: [S.ByteString]+sortInputs = map (`S.take` S.pack [122, 121 .. 32]) [10..25]++foldInputs :: [S.ByteString]+foldInputs = map (\k -> S.pack $ if k <= 6 then take (2 ^ k) [32..95] else concat (replicate (2 ^ (k - 6)) [32..95])) [0..16]++zeroes :: L.ByteString+zeroes = L.replicate 10000 0++zeroOneRepeating :: L.ByteString+zeroOneRepeating = L.take 10000 (L.cycle (L.pack [0,1]))+++largeTraversalInput :: S.ByteString+largeTraversalInput = S.concat (replicate 10 byteStringData)++smallTraversalInput :: S.ByteString+smallTraversalInput = S8.pack "The quick brown fox"++main :: IO ()+main = do+ mapM_ putStrLn sanityCheckInfo+ defaultMain+ [ bgroup "Data.ByteString.Builder"+ [ bgroup "Small payload"+ [ benchB' "mempty" () (const mempty)+ , benchB' "ensureFree 8" () (const (ensureFree 8))+ , benchB' "intHost 1" 1 intHost+ , benchB' "UTF-8 String (naive)" "hello world\0" fromString+ , benchB' "UTF-8 String" () $ \() -> P.cstringUtf8 "hello world\0"#+ , benchB' "String (naive)" "hello world!" fromString+ , benchB' "String" () $ \() -> P.cstring "hello world!"#+ ]++ , bgroup "Encoding wrappers"+ [ benchBInts "foldMap word8" $+ foldMap (word8 . fromIntegral)+ , benchBInts "primMapListFixed word8" $+ P.primMapListFixed (fromIntegral >$< P.word8)+ , benchB "primUnfoldrFixed word8" nRepl $+ P.primUnfoldrFixed (fromIntegral >$< P.word8) countToZero+ , benchB "primMapByteStringFixed word8" byteStringData $+ P.primMapByteStringFixed P.word8+ , benchB "primMapLazyByteStringFixed word8" lazyByteStringData $+ P.primMapLazyByteStringFixed P.word8+ ]+ , bgroup "ByteString insertion" $+ let dataName = " byteStringChunks" +++ show (S.length (head byteStringChunksData)) ++ "Data"+ in+ [ benchB ("foldMap byteStringInsert" ++ dataName) byteStringChunksData+ (foldMap byteStringInsert)+ , benchB ("foldMap byteString" ++ dataName) byteStringChunksData+ (foldMap byteString)+ , benchB ("foldMap byteStringCopy" ++ dataName) byteStringChunksData+ (foldMap byteStringCopy)+ ]++ , bgroup "Non-bounded encodings"+ [ benchB "byteStringHex" byteStringData $ byteStringHex+ , benchB "lazyByteStringHex" lazyByteStringData $ lazyByteStringHex+ , benchB "foldMap floatDec" floatData $ foldMap floatDec+ , benchB "foldMap doubleDec" doubleData $ foldMap doubleDec+ -- Note that the small data corresponds to the intData pre-converted+ -- to Integer.+ , benchB "foldMap integerDec (small)" smallIntegerData $ foldMap integerDec+ , benchB "foldMap integerDec (large)" largeIntegerData $ foldMap integerDec+ ]+ ]++ , bgroup "Data.ByteString.Builder.Prim"+ [ benchFE "char7" $ toEnum >$< P.char7+ , benchFE "char8" $ toEnum >$< P.char8+ , benchBE "charUtf8" $ toEnum >$< P.charUtf8++ -- binary encoding+ , benchFE "int8" $ fromIntegral >$< P.int8+ , benchFE "word8" $ fromIntegral >$< P.word8++ -- big-endian+ , benchFE "int16BE" $ fromIntegral >$< P.int16BE+ , benchFE "int32BE" $ fromIntegral >$< P.int32BE+ , benchFE "int64BE" $ fromIntegral >$< P.int64BE++ , benchFE "word16BE" $ fromIntegral >$< P.word16BE+ , benchFE "word32BE" $ fromIntegral >$< P.word32BE+ , benchFE "word64BE" $ fromIntegral >$< P.word64BE++ , benchFE "floatBE" $ fromIntegral >$< P.floatBE+ , benchFE "doubleBE" $ fromIntegral >$< P.doubleBE++ -- little-endian+ , benchFE "int16LE" $ fromIntegral >$< P.int16LE+ , benchFE "int32LE" $ fromIntegral >$< P.int32LE+ , benchFE "int64LE" $ fromIntegral >$< P.int64LE++ , benchFE "word16LE" $ fromIntegral >$< P.word16LE+ , benchFE "word32LE" $ fromIntegral >$< P.word32LE+ , benchFE "word64LE" $ fromIntegral >$< P.word64LE++ , benchFE "floatLE" $ fromIntegral >$< P.floatLE+ , benchFE "doubleLE" $ fromIntegral >$< P.doubleLE++ -- host-dependent+ , benchFE "int16Host" $ fromIntegral >$< P.int16Host+ , benchFE "int32Host" $ fromIntegral >$< P.int32Host+ , benchFE "int64Host" $ fromIntegral >$< P.int64Host+ , benchFE "intHost" $ fromIntegral >$< P.intHost++ , benchFE "word16Host" $ fromIntegral >$< P.word16Host+ , benchFE "word32Host" $ fromIntegral >$< P.word32Host+ , benchFE "word64Host" $ fromIntegral >$< P.word64Host+ , benchFE "wordHost" $ fromIntegral >$< P.wordHost++ , benchFE "floatHost" $ fromIntegral >$< P.floatHost+ , benchFE "doubleHost" $ fromIntegral >$< P.doubleHost+ ]++ , bgroup "Data.ByteString.Builder.Prim.ASCII"+ [+ -- decimal number+ benchBE "int8Dec" $ fromIntegral >$< P.int8Dec+ , benchBE "int16Dec" $ fromIntegral >$< P.int16Dec+ , benchBE "int32Dec" $ fromIntegral >$< P.int32Dec+ , benchBE "int64Dec" $ fromIntegral >$< P.int64Dec+ , benchBE "intDec" $ fromIntegral >$< P.intDec++ , benchBE "word8Dec" $ fromIntegral >$< P.word8Dec+ , benchBE "word16Dec" $ fromIntegral >$< P.word16Dec+ , benchBE "word32Dec" $ fromIntegral >$< P.word32Dec+ , benchBE "word64Dec" $ fromIntegral >$< P.word64Dec+ , benchBE "wordDec" $ fromIntegral >$< P.wordDec++ -- hexadecimal number+ , benchBE "word8Hex" $ fromIntegral >$< P.word8Hex+ , benchBE "word16Hex" $ fromIntegral >$< P.word16Hex+ , benchBE "word32Hex" $ fromIntegral >$< P.word32Hex+ , benchBE "word64Hex" $ fromIntegral >$< P.word64Hex+ , benchBE "wordHex" $ fromIntegral >$< P.wordHex++ -- fixed-width hexadecimal numbers+ , benchFE "int8HexFixed" $ fromIntegral >$< P.int8HexFixed+ , benchFE "int16HexFixed" $ fromIntegral >$< P.int16HexFixed+ , benchFE "int32HexFixed" $ fromIntegral >$< P.int32HexFixed+ , benchFE "int64HexFixed" $ fromIntegral >$< P.int64HexFixed++ , benchFE "word8HexFixed" $ fromIntegral >$< P.word8HexFixed+ , benchFE "word16HexFixed" $ fromIntegral >$< P.word16HexFixed+ , benchFE "word32HexFixed" $ fromIntegral >$< P.word32HexFixed+ , benchFE "word64HexFixed" $ fromIntegral >$< P.word64HexFixed++ , benchFE "floatHexFixed" $ fromIntegral >$< P.floatHexFixed+ , benchFE "doubleHexFixed" $ fromIntegral >$< P.doubleHexFixed+ ]+ , bgroup "intersperse"+ [ bench "intersperse" $ whnf (S.intersperse 32) byteStringData+ , bench "intersperse (unaligned)" $ whnf (S.intersperse 32) (S.drop 1 byteStringData)+ ]+ , bgroup "partition"+ [+ bgroup "strict"+ [+ bench "mostlyTrueFast" $ partitionStrict (< (w 225))+ , bench "mostlyFalseFast" $ partitionStrict (< (w 10))+ , bench "balancedFast" $ partitionStrict (< (w 128))++ , bench "mostlyTrueSlow" $ partitionStrict (\x -> hashWord8 x < w 225)+ , bench "mostlyFalseSlow" $ partitionStrict (\x -> hashWord8 x < w 10)+ , bench "balancedSlow" $ partitionStrict (\x -> hashWord8 x < w 128)+ ]+ , bgroup "lazy"+ [+ bench "mostlyTrueFast" $ partitionLazy (< (w 225))+ , bench "mostlyFalseFast" $ partitionLazy (< (w 10))+ , bench "balancedFast" $ partitionLazy (< (w 128))++ , bench "mostlyTrueSlow" $ partitionLazy (\x -> hashWord8 x < w 225)+ , bench "mostlyFalseSlow" $ partitionLazy (\x -> hashWord8 x < w 10)+ , bench "balancedSlow" $ partitionLazy (\x -> hashWord8 x < w 128)+ ]+ ]+ , bgroup "sort" $ map (\s -> bench (S8.unpack s) $ nf S.sort s) sortInputs+ , bgroup "words"+ [ bench "lorem ipsum" $ nf S8.words loremIpsum+ , bench "one huge word" $ nf S8.words byteStringData+ ]+ , bgroup "folds"+ [ bgroup "foldl'" $ map (\s -> bench (show $ S.length s) $+ nf (S.foldl' (\acc x -> acc + fromIntegral x) (0 :: Int)) s) foldInputs+ , bgroup "foldr'" $ map (\s -> bench (show $ S.length s) $+ nf (S.foldr' (\x acc -> fromIntegral x + acc) (0 :: Int)) s) foldInputs+ , bgroup "mapAccumL" $ map (\s -> bench (show $ S.length s) $+ nf (S.mapAccumL (\acc x -> (acc + fromIntegral x, succ x)) (0 :: Int)) s) foldInputs+ , bgroup "mapAccumR" $ map (\s -> bench (show $ S.length s) $+ nf (S.mapAccumR (\acc x -> (fromIntegral x + acc, succ x)) (0 :: Int)) s) foldInputs+ , bgroup "scanl" $ map (\s -> bench (show $ S.length s) $+ nf (S.scanl (+) 0) s) foldInputs+ , bgroup "scanr" $ map (\s -> bench (show $ S.length s) $+ nf (S.scanr (+) 0) s) foldInputs+ , bgroup "filter" $ map (\s -> bench (show $ S.length s) $+ nf (S.filter odd) s) foldInputs+ ]+ , bgroup "findIndexOrLength"+ [ bench "takeWhile" $ nf (L.takeWhile even) zeroes+ , bench "dropWhile" $ nf (L.dropWhile even) zeroes+ , bench "break" $ nf (L.break odd) zeroes+ , bench "group zeroes" $ nf L.group zeroes+ , bench "group zero-one" $ nf L.group zeroOneRepeating+ , bench "groupBy (>=)" $ nf (L.groupBy (>=)) zeroes+ , bench "groupBy (>)" $ nf (L.groupBy (>)) zeroes+ ]+ , bgroup "findIndex_"+ [ bench "findIndices" $ nf (sum . S.findIndices (\x -> x == 129 || x == 72)) byteStringData+ , bench "find" $ nf (S.find (>= 198)) byteStringData+ ]+ , bgroup "findIndexEnd"+ [ bench "findIndexEnd" $ nf (S.findIndexEnd (<= 57)) byteStringData+ , bench "elemIndexInd" $ nf (S.elemIndexEnd 42) byteStringData+ ]+ , bgroup "traversals"+ [ bench "map (+1)" $ nf (S.map (+ 1)) largeTraversalInput+ , bench "map (+1)" $ nf (S.map (+ 1)) smallTraversalInput+ ]+ , benchBoundsCheckFusion+ , benchCSV+ , benchIndices+ ]
+ bench/BenchBoundsCheckFusion.hs view
@@ -0,0 +1,105 @@+-- |+-- Copyright : (c) 2011 Simon Meier+-- License : BSD3-style (see LICENSE)+--+-- Maintainer : Simon Meier <iridcode@gmail.com>+-- Stability : experimental+-- Portability : tested on GHC only+--+-- Benchmark that the bounds checks fuse.++{-# LANGUAGE PackageImports, ScopedTypeVariables, BangPatterns #-}++module BenchBoundsCheckFusion (benchBoundsCheckFusion) where++import Prelude hiding (words)+import Data.Monoid+import Data.Foldable (foldMap)+import Test.Tasty.Bench++import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L++import Data.ByteString.Builder+import Data.ByteString.Builder.Extra+import Data.ByteString.Builder.Prim+ ( FixedPrim, BoundedPrim, (>$<), (>*<) )+import qualified Data.ByteString.Builder.Prim as P+import qualified Data.ByteString.Builder.Internal as I+import qualified Data.ByteString.Builder.Prim.Internal as I++import Foreign++------------------------------------------------------------------------------+-- Benchmark support+------------------------------------------------------------------------------++countToZero :: Int -> Maybe (Int, Int)+countToZero 0 = Nothing+countToZero n = Just (n, n - 1)+++------------------------------------------------------------------------------+-- Benchmark+------------------------------------------------------------------------------++-- input data (NOINLINE to ensure memoization)+----------------------------------------------++-- | Few-enough repetitions to avoid making GC too expensive.+nRepl :: Int+nRepl = 10000++{-# NOINLINE intData #-}+intData :: [Int]+intData = [1..nRepl]++-- benchmark wrappers+---------------------++{-# INLINE benchB #-}+benchB :: String -> a -> (a -> Builder) -> Benchmark+benchB name x b =+ bench (name ++" (" ++ show nRepl ++ ")") $+ whnf (L.length . toLazyByteString . b) x++{-# INLINE benchBInts #-}+benchBInts :: String -> ([Int] -> Builder) -> Benchmark+benchBInts name = benchB name intData+++-- benchmarks+-------------++benchBoundsCheckFusion :: Benchmark+benchBoundsCheckFusion = bgroup "BoundsCheckFusion"+ [ bgroup "Data.ByteString.Builder"+ [ benchBInts "foldMap (left-assoc)" $+ foldMap (\x -> (stringUtf8 "s" `mappend` intHost x) `mappend` intHost x)++ , benchBInts "foldMap (right-assoc)" $+ foldMap (\x -> intHost x `mappend` (intHost x `mappend` stringUtf8 "s"))++ , benchBInts "foldMap [manually fused, left-assoc]" $+ foldMap (\x -> stringUtf8 "s" `mappend` P.primBounded (P.liftFixedToBounded $ P.intHost >*< P.intHost) (x, x))++ , benchBInts "foldMap [manually fused, right-assoc]" $+ foldMap (\x -> P.primBounded (P.liftFixedToBounded $ P.intHost >*< P.intHost) (x, x) `mappend` stringUtf8 "s")+ ]+ ]++{-# RULES++"append/encodeWithB" forall w1 w2 x1 x2.+ I.append (P.primBounded w1 x1) (P.primBounded w2 x2)+ = P.primBounded (I.pairB w1 w2) (x1, x2)++"append/encodeWithB/assoc_r" forall w1 w2 x1 x2 b.+ I.append (P.primBounded w1 x1) (I.append (P.primBounded w2 x2) b)+ = I.append (P.primBounded (I.pairB w1 w2) (x1, x2)) b++"append/encodeWithB/assoc_l" forall w1 w2 x1 x2 b.+ I.append (I.append b (P.primBounded w1 x1)) (P.primBounded w2 x2)+ = I.append b (P.primBounded (I.pairB w1 w2) (x1, x2))+ #-}+
+ bench/BenchCSV.hs view
@@ -0,0 +1,547 @@+-- |+-- Copyright : (c) 2010-2011 Simon Meier+-- License : BSD3-style (see LICENSE)+--+-- Maintainer : Simon Meier <iridcode@gmail.com>+-- Stability : experimental+-- Portability : tested on GHC only+--+-- Running example for documentation of Data.ByteString.Builder+--++{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}++module BenchCSV (benchCSV) where++-- **************************************************************************+-- CamHac 2011: An introduction to Data.ByteString.Builder+-- **************************************************************************+++{- The Encoding Problem+ ----------------------++ Encoding: Conversion from a Haskell value to a sequence of bytes.+++ Efficient encoding implementation:++ 1. represent sequence of bytes as a list of byte arrays (chunks)+ 2. generate chunks that are large on average+ 3. avoid intermediate copies/datastructures++ Compositionality:++ 4. support fast append+++ Problem: Provide a library for defining compositional, efficient encodings.++-}++++{- Data.ByteString.Builder+ ------------------------------++ A solution to the "Encoding Problem" (based on the code of blaze-builder).++ Builder creation:++ word8 :: Word8 -> Builder+ int64LE :: Int64 -> Builder+ floatBE :: Float -> Builder+ ....+++ Builder composition via its Monoid instance:++ word8 10 `mappend` floatBE 1.4+++ Builder execution by converting it to a lazy bytestring:++ toLazyByteString :: Builder -> L.ByteString++-}+++{- Typical users of Builders+ ---------------------------++ binary, text, aeson, blaze-html, blaze-textual, warp, snap-server, ...++ => they want support for maximal performance!+ => use of Builders is rather local: in rendering/encoding functions.++-}++++{- Notable properties+ --------------------++ * Built-in UTF-8 support: very hard to get efficient otherwise.++ stringUtf8 :: String -> Builder+ intDec :: Int -> Builder+ intHex :: Int -> Builder++ * Fine-grained control over when to copy/reference existing bytestrings++ * EDSL for defining low-level Encodings of bounded values (e.g., Int, Char)+ to improve speed of escaping and similar operations.++ * If used together with iteratee-style IO: no 'unsafePerformIO' required++-}+++{- An example problem:+ ---------------------++ Rendering a table in comma-separated-value (CSV) format using UTF-8 encoded+ Unicode characters.++ * We are willing to fuse table-rendering with UTF8-encoding to achieve better+ performance.++-}++import Control.DeepSeq+import Data.Char (ord)+import Data.Foldable (foldMap)+import Data.Monoid++import Test.Tasty.Bench++import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L+import Data.ByteString.Builder as B+import Data.ByteString.Builder.Prim.Internal ( (>*<), (>$<) )+import qualified Data.ByteString.Builder.Prim as E++-- To be used in a later comparison+import qualified Data.DList as D++-- bytestring benchmarks cannot depend on text because of a circular dependency.+-- Anyways these comparisons are of historical interest only, so disabled for now.+-- A curious soul can re-enable them by moving benchmarks to a separate package+-- and adding text to build-depends.+#ifdef MIN_VERSION_text+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL+import qualified Data.Text.Lazy.Builder as TB+import qualified Data.Text.Lazy.Builder.Int as TB+#endif++------------------------------------------------------------------------------+-- Simplife CSV Tables+------------------------------------------------------------------------------++data Cell = StringC String+ | IntC Int+ deriving( Eq, Ord, Show )++type Row = [Cell]+type Table = [Row]++-- Example data+strings :: [String]+strings = ["hello", "\"1\"", "λ-wörld"]++table :: Table+table = [map StringC strings, map IntC [-3..3]]+++-- | The rendered 'table':+--+-- > "hello","\"1\"","λ-wörld"+-- > -3,-2,-1,0,1,2,3+--+++-- | A bigger table for benchmarking our encoding functions.+maxiTable :: Table+maxiTable = take 1000 $ cycle table+++------------------------------------------------------------------------------+-- String based rendering+------------------------------------------------------------------------------++renderString :: String -> String+renderString cs = "\"" ++ concatMap escape cs ++ "\""+ where+ escape '\\' = "\\"+ escape '\"' = "\\\""+ escape c = return c++renderCell :: Cell -> String+renderCell (StringC cs) = renderString cs+renderCell (IntC i) = show i++renderRow :: Row -> String+renderRow [] = ""+renderRow (c:cs) = renderCell c ++ concat [',' : renderCell c' | c' <- cs]++renderTable :: Table -> String+renderTable rs = concat [renderRow r ++ "\n" | r <- rs]++-- 1.36 ms+benchString :: Benchmark+benchString = bench "renderTable maxiTable" $ nf renderTable maxiTable++-- 1.36 ms+benchStringUtf8 :: Benchmark+benchStringUtf8 = bench "utf8 + renderTable maxiTable" $+ nf (L.length . B.toLazyByteString . B.stringUtf8 . renderTable) maxiTable+++-- using difference lists: 0.91 ms+--+-- (++) is a performance-grinch!+++------------------------------------------------------------------------------+-- Builder based rendering+------------------------------------------------------------------------------++-- As a reminder:+--+-- import Data.ByteString.Builder as B++renderStringB :: String -> Builder+renderStringB cs = B.charUtf8 '"' <> foldMap escape cs <> B.charUtf8 '"'+ where+ escape '\\' = B.charUtf8 '\\' <> B.charUtf8 '\\'+ escape '\"' = B.charUtf8 '\\' <> B.charUtf8 '"'+ escape c = B.charUtf8 c++renderCellB :: Cell -> Builder+renderCellB (StringC cs) = renderStringB cs+renderCellB (IntC i) = B.intDec i++renderRowB :: Row -> Builder+renderRowB [] = mempty+renderRowB (c:cs) =+ renderCellB c <> mconcat [ B.charUtf8 ',' <> renderCellB c' | c' <- cs ]++renderTableB :: Table -> Builder+renderTableB rs = mconcat [renderRowB r <> B.charUtf8 '\n' | r <- rs]++-- 0.81ms+benchBuilderUtf8 :: Benchmark+benchBuilderUtf8 = bench "utf8 + renderTableB maxiTable" $+ nf (L.length . B.toLazyByteString . renderTableB) maxiTable++-- 1.11x faster than DList++-- However: touching the whole table 'nf maxiTable' takes 0.27ms++-- 1.16x faster than DList on the code path other than touching all data+-- (0.91 - 0.27) / (0.82 - 0.27)+++------------------------------------------------------------------------------+-- Baseline: Touching all data+------------------------------------------------------------------------------++instance NFData Cell where+ rnf (StringC cs) = rnf cs+ rnf (IntC i) = rnf i++-- 0.27 ms+benchNF :: Benchmark+benchNF = bench "nf maxiTable" $ nf id maxiTable+++------------------------------------------------------------------------------+-- Exploiting bounded encodings+------------------------------------------------------------------------------++{- Why 'Bounded Encodings'?+ --------------------------++ Hot code of encoding implementations:++ * Appending Builders: Optimized already.++ * Encoding primitive Haskell values: room for optimization:++ - reduce buffer-free checks+ - remove jumps/function calls+ - hoist constant values out of inner-loops+ (e.g., the loop for encoding the elements of a list)++ * Bounded encoding:+ an encoding that never takes more than a fixed number of bytes.++ - intuitively: (Int, Ptr Word8 -> IO (Ptr Word8))+ ^bound ^ low-level encoding function++ - compositional: coalesce buffer-checks, ...++ E.encodeIfB :: (a -> Bool)+ -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a+ E.charUtf8 :: BoundedPrim Char+ (>*<) :: BoundedPrim a -> BoundedPrim b -> BoundedPrim (a, b)++ (>$<) :: (b -> a) -> BoundedPrim a -> BoundedPrim b++ ^ BoundedPrims are contrafunctors; like most data-sinks+++ - Implementation relies heavily on inlining to compute bounds and+ low-level encoding code during compilation.+-}++renderStringBE :: String -> Builder+renderStringBE cs =+ B.charUtf8 '"' <> E.primMapListBounded escape cs <> B.charUtf8 '"'+ where+ escape :: E.BoundedPrim Char+ escape =+ E.condB (== '\\') (const ('\\', '\\') >$< E.charUtf8 >*< E.charUtf8) $+ E.condB (== '\"') (const ('\\', '\"') >$< E.charUtf8 >*< E.charUtf8) $+ E.charUtf8++renderCellBE :: Cell -> Builder+renderCellBE (StringC cs) = renderStringBE cs+renderCellBE (IntC i) = B.intDec i++renderRowBE :: Row -> Builder+renderRowBE [] = mempty+renderRowBE (c:cs) =+ renderCellBE c <> mconcat [ B.charUtf8 ',' <> renderCellBE c' | c' <- cs ]++renderTableBE :: Table -> Builder+renderTableBE rs = mconcat [renderRowBE r <> B.charUtf8 '\n' | r <- rs]++-- 0.65 ms+benchBuilderEncodingUtf8 :: Benchmark+benchBuilderEncodingUtf8 = bench "utf8 + renderTableBE maxiTable" $+ nf (L.length . B.toLazyByteString . renderTableBE) maxiTable+++-- 1.4x faster than DList based++-- 1.7x faster than DList based on code other than touching all data+++------------------------------------------------------------------------------+-- Difference-list based rendering+------------------------------------------------------------------------------++type DString = D.DList Char++renderStringD :: String -> DString+renderStringD cs = return '"' <> foldMap escape cs <> return '"'+ where+ escape '\\' = D.fromList "\\\\"+ escape '\"' = D.fromList "\\\""+ escape c = return c++renderCellD :: Cell -> DString+renderCellD (StringC cs) = renderStringD cs+renderCellD (IntC i) = D.fromList $ show i++renderRowD :: Row -> DString+renderRowD [] = mempty+renderRowD (c:cs) =+ renderCellD c <> mconcat [ return ',' <> renderCellD c' | c' <- cs ]++renderTableD :: Table -> DString+renderTableD rs = mconcat [renderRowD r <> return '\n' | r <- rs]++-- 0.91 ms+benchDListUtf8 :: Benchmark+benchDListUtf8 = bench "utf8 + renderTableD maxiTable" $+ nf (L.length . B.toLazyByteString . B.stringUtf8 . D.toList . renderTableD) maxiTable++------------------------------------------------------------------------------+-- Text Builder+------------------------------------------------------------------------------++#ifdef MIN_VERSION_text++renderStringTB :: String -> TB.Builder+renderStringTB cs = TB.singleton '"' <> foldMap escape cs <> TB.singleton '"'+ where+ escape '\\' = "\\\\"+ escape '\"' = "\\\""+ escape c = TB.singleton c++renderCellTB :: Cell -> TB.Builder+renderCellTB (StringC cs) = renderStringTB cs+renderCellTB (IntC i) = TB.decimal i++renderRowTB :: Row -> TB.Builder+renderRowTB [] = mempty+renderRowTB (c:cs) =+ renderCellTB c <> mconcat [ TB.singleton ',' <> renderCellTB c' | c' <- cs ]++renderTableTB :: Table -> TB.Builder+renderTableTB rs = mconcat [renderRowTB r <> TB.singleton '\n' | r <- rs]++-- 0.95 ms+benchTextBuilder :: Benchmark+benchTextBuilder = bench "renderTableTB maxiTable" $+ nf (TL.length . TB.toLazyText . renderTableTB) maxiTable++-- 1.10 ms+benchTextBuilderUtf8 :: Benchmark+benchTextBuilderUtf8 = bench "utf8 + renderTableTB maxiTable" $+ nf (L.length . TL.encodeUtf8 . TB.toLazyText . renderTableTB) maxiTable++#endif++------------------------------------------------------------------------------+-- Benchmarking+------------------------------------------------------------------------------++benchCSV :: Benchmark+benchCSV = bgroup "CSV"+ [ benchNF+ , benchString+ , benchStringUtf8+ , benchDListUtf8+#ifdef MIN_VERSION_text+ , benchTextBuilder+ , benchTextBuilderUtf8+#endif+ , benchBuilderUtf8+ , benchBuilderEncodingUtf8+ ]+ where+ encodeUtf8CSV = B.toLazyByteString . renderTableBE+++{- On a Core 2 Duo 2.2 GHz running a 32-bit Linux:+++touching all data: 0.25 ms+string rendering: 1.36 ms+string rendering + utf8 encoding: 1.36 ms+DList rendering + utf8 encoding: 0.91 ms+builder rendering (incl. utf8): 0.82 ms+builder + faster escaping: 0.65 ms++text builder: 0.95 ms+text builder + utf8 encoding: 1.10 ms+binary builder + char8 (!!): 1.22 ms+DList render + utf8-light: 4.12 ms++How to improve further?+ * Use packed formats for string literals+ - fast memcpy (that's what blaze-html does for tags)+ - using Text literals should also help+++results from criterion:++benchmarking nf maxiTable+mean: 257.2927 us, lb 255.9210 us, ub 259.6692 us, ci 0.950+std dev: 9.026280 us, lb 5.887942 us, ub 12.76582 us, ci 0.950++benchmarking renderTable maxiTable+mean: 1.358458 ms, lb 1.356732 ms, ub 1.362377 ms, ci 0.950+std dev: 12.66932 us, lb 7.110377 us, ub 24.97397 us, ci 0.950++benchmarking utf8 + renderTable maxiTable+mean: 1.364343 ms, lb 1.362391 ms, ub 1.366973 ms, ci 0.950+std dev: 11.65388 us, lb 9.094074 us, ub 17.47765 us, ci 0.950++benchmarking utf8 + renderTableD maxiTable+mean: 909.5255 us, lb 908.0049 us, ub 911.7639 us, ci 0.950+std dev: 9.434182 us, lb 6.906120 us, ub 15.43223 us, ci 0.950++benchmarking utf8-light + renderTable maxiTable+mean: 4.128315 ms, lb 4.121109 ms, ub 4.138436 ms, ci 0.950+std dev: 42.93755 us, lb 32.58115 us, ub 58.61780 us, ci 0.950++benchmarking char8 + renderTableBinB maxiTable+mean: 1.224156 ms, lb 1.222510 ms, ub 1.226101 ms, ci 0.950+std dev: 9.046150 us, lb 7.568433 us, ub 11.74996 us, ci 0.950++benchmarking renderTableTB maxiTable+mean: 954.8066 us, lb 953.6650 us, ub 957.0134 us, ci 0.950+std dev: 7.763098 us, lb 5.072194 us, ub 14.09216 us, ci 0.950++benchmarking utf8 + renderTableTB maxiTable+mean: 1.095913 ms, lb 1.094811 ms, ub 1.098280 ms, ci 0.950+std dev: 7.865781 us, lb 4.189907 us, ub 15.24606 us, ci 0.950++benchmarking utf8 + renderTableB maxiTable+mean: 818.0223 us, lb 816.5118 us, ub 819.9397 us, ci 0.950+std dev: 8.603917 us, lb 6.764347 us, ub 12.29236 us, ci 0.950++benchmarking utf8 + renderTableBE maxiTable+mean: 646.5248 us, lb 645.3735 us, ub 648.2405 us, ci 0.950+std dev: 7.147889 us, lb 5.222494 us, ub 11.82482 us, ci 0.950++-}++++{- Conclusion:+ -------------++ * Whenever generating a sequence of bytes: use the 'Builder' type++ => chunks can always be kept large; impossible when exporting only+ a strict/lazy bytestring interface.++ => filtering/mapping lazy bytestrings now automatically defragments+ the output and guarantees a large chunk size.+++ * Status of work: API complete, documentation needs more reviewing.+++ * Bounded encodings: safely exploiting low-level optimizations++ => a performance advantage on other outputstream-libraries?+++ ---------------+ - Questions ? -+ ---------------++-}+++++{- Implementation outline:+ ------------------------++data BufferRange = BufferRange {-# UNPACK #-} !(Ptr Word8) -- First byte of range+ {-# UNPACK #-} !(Ptr Word8) -- First byte /after/ range++newtype BuildStep a =+ BuildStep { runBuildStep :: BufferRange -> IO (BuildSignal a) }++data BuildSignal a =+ Done !(Ptr Word8) -- next free byte in current buffer+ a -- return value+ | BufferFull+ !Int -- minimal size of next buffer+ !(Ptr Word8) -- next free byte in current buffer+ !(BuildStep a) -- continuation to call on next buffer+ | InsertByteString+ !(Ptr Word8) -- next free byte in current buffer+ !S.ByteString -- bytestring to insert directly+ !(BuildStep a) -- continuation to call on next buffer+++-- | A "difference list" of build-steps.+newtype Builder = Builder (forall r. BuildStep r -> BuildStep r)+++-- | The corresponding "Writer" monad.+newtype Put a = Put { unPut :: forall r. (a -> BuildStep r) -> BuildStep r }+++-}
+ bench/BenchIndices.hs view
@@ -0,0 +1,83 @@+-- |+-- Copyright : (c) 2020 Peter Duchovni+-- License : BSD3-style (see LICENSE)+--+-- Maintainer : Peter Duchovni <caufeminecraft+github@gmail.com>+--+-- Benchmark elemIndex, findIndex, elemIndices, and findIndices++{-# LANGUAGE BangPatterns #-}++module BenchIndices (benchIndices) where++import Data.Foldable (foldMap)+import Data.Maybe (listToMaybe)+import Data.Monoid+import Data.String+import Test.Tasty.Bench+import Prelude hiding (words)+import Data.Word (Word8)++import qualified Data.ByteString as S+import qualified Data.ByteString.Unsafe as S+++------------------------------------------------------------------------------+-- Benchmark+------------------------------------------------------------------------------++-- ASCII \n to ensure no typos+nl :: Word8+nl = 0xa+{-# INLINE nl #-}++-- non-inlined equality test+nilEq :: Word8 -> Word8 -> Bool+{-# NOINLINE nilEq #-}+nilEq = (==)++-- lines of 200 letters from a to e, followed by repeated letter f+absurdlong :: S.ByteString+absurdlong = S.replicate 200 0x61 <> S.singleton nl+ <> S.replicate 200 0x62 <> S.singleton nl+ <> S.replicate 200 0x63 <> S.singleton nl+ <> S.replicate 200 0x64 <> S.singleton nl+ <> S.replicate 200 0x65 <> S.singleton nl+ <> S.replicate 999999 0x66++benchIndices :: Benchmark+benchIndices = bgroup "Indices"+ [ bgroup "ByteString strict first index" $+ [ bench "FindIndices" $ nf (listToMaybe . S.findIndices (== nl)) absurdlong+ , bench "ElemIndices" $ nf (listToMaybe . S.elemIndices nl) absurdlong+ , bench "FindIndex" $ nf (S.findIndex (== nl)) absurdlong+ , bench "ElemIndex" $ nf (S.elemIndex nl) absurdlong+ ]+ , bgroup "ByteString strict second index" $+ [ bench "FindIndices" $ nf (listToMaybe . tail . S.findIndices (== nl)) absurdlong+ , bench "ElemIndices" $ nf (listToMaybe . tail . S.elemIndices nl) absurdlong+ , bench "FindIndex" $ nf bench_find_index_second absurdlong+ , bench "ElemIndex" $ nf bench_elem_index_second absurdlong+ ]+ , bgroup "ByteString index equality inlining" $+ [ bench "FindIndices/inlined" $ nf (S.findIndices (== nl)) absurdlong+ , bench "FindIndices/non-inlined" $ nf (S.findIndices (nilEq nl)) absurdlong+ , bench "FindIndex/inlined" $ nf (S.findIndex (== nl)) absurdlong+ , bench "FindIndex/non-inlined" $ nf (S.findIndex (nilEq nl)) absurdlong+ ]+ ]++bench_find_index_second :: S.ByteString -> Maybe Int+bench_find_index_second bs =+ let isNl = (== nl)+ in case S.findIndex isNl bs of+ Just !i -> S.findIndex isNl (S.unsafeDrop (i+1) bs)+ Nothing -> Nothing+{-# INLINE bench_find_index_second #-}++bench_elem_index_second :: S.ByteString -> Maybe Int+bench_elem_index_second bs =+ case S.elemIndex nl bs of+ Just !i -> S.elemIndex nl (S.unsafeDrop (i+1) bs)+ Nothing -> Nothing+{-# INLINE bench_elem_index_second #-}
bytestring.cabal view
@@ -1,5 +1,5 @@ Name: bytestring-Version: 0.11.0.0+Version: 0.11.1.0 Synopsis: Fast, compact, strict and lazy byte strings with a list interface Description: An efficient compact, immutable byte string type (both strict and lazy)@@ -51,7 +51,7 @@ Author: Don Stewart, Duncan Coutts-Maintainer: Duncan Coutts <duncan@community.haskell.org>+Maintainer: Haskell Bytestring Team <andrew.lelechenko@gmail.com>, Core Libraries Committee Homepage: https://github.com/haskell/bytestring Bug-reports: https://github.com/haskell/bytestring/issues Tested-With: GHC==8.10.1, GHC==8.8.3, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2,@@ -94,10 +94,9 @@ Data.ByteString.Builder.Prim.Binary Data.ByteString.Builder.Prim.ASCII Data.ByteString.Builder.Prim.Internal.Floating- Data.ByteString.Builder.Prim.Internal.UncheckedShifts Data.ByteString.Builder.Prim.Internal.Base16 - default-language: Haskell98+ default-language: Haskell2010 other-extensions: CPP, ForeignFunctionInterface, BangPatterns@@ -140,3 +139,60 @@ if impl(ghc >= 6.9) && impl(ghc < 6.11) cpp-options: -DINTEGER_GMP build-depends: integer >= 0.1 && < 0.2++test-suite prop-compiled+ type: exitcode-stdio-1.0+ main-is: Properties.hs+ other-modules: Rules+ QuickCheckUtils+ hs-source-dirs: tests+ build-depends: base, bytestring, ghc-prim, deepseq,+ tasty, tasty-quickcheck+ ghc-options: -fwarn-unused-binds+ -threaded -rtsopts+ default-language: Haskell2010++test-suite lazy-hclose+ type: exitcode-stdio-1.0+ main-is: LazyHClose.hs+ hs-source-dirs: tests+ build-depends: base, bytestring, ghc-prim, deepseq,+ tasty, tasty-quickcheck+ ghc-options: -fwarn-unused-binds+ -threaded -rtsopts+ default-language: Haskell2010++test-suite test-builder+ type: exitcode-stdio-1.0+ hs-source-dirs: tests/builder+ main-is: TestSuite.hs+ other-modules: Data.ByteString.Builder.Tests+ Data.ByteString.Builder.Prim.Tests+ Data.ByteString.Builder.Prim.TestUtils+ build-depends: base, bytestring, ghc-prim,+ deepseq,+ dlist >= 0.5 && < 0.9,+ transformers >= 0.3,+ tasty,+ tasty-hunit,+ tasty-quickcheck+ if impl(ghc < 8.4)+ build-depends: ghc-byteorder+ ghc-options: -Wall -fwarn-tabs -threaded -rtsopts+ default-language: Haskell2010++benchmark bytestring-bench+ main-is: BenchAll.hs+ other-modules: BenchBoundsCheckFusion+ BenchCSV+ BenchIndices+ type: exitcode-stdio-1.0+ hs-source-dirs: bench+ default-language: Haskell2010+ ghc-options: -O2+ build-depends: base,+ bytestring,+ deepseq,+ dlist,+ tasty-bench,+ random
cbits/fpstring.c view
@@ -30,6 +30,10 @@ */ #include "fpstring.h"+#if defined(__x86_64__)+#include <emmintrin.h>+#include <xmmintrin.h>+#endif /* copy a string in reverse */ void fps_reverse(unsigned char *q, unsigned char *p, size_t n) {@@ -44,7 +48,21 @@ unsigned char *p, size_t n, unsigned char c) {-+#if defined(__x86_64__)+ {+ const __m128i separator = _mm_set1_epi8(c);+ const unsigned char *const p_begin = p;+ const unsigned char *const p_end = p_begin + n - 9;+ while (p < p_end) {+ const __m128i eight_src_bytes = _mm_loadl_epi64((__m128i *)p);+ const __m128i sixteen_dst_bytes = _mm_unpacklo_epi8(eight_src_bytes, separator);+ _mm_storeu_si128((__m128i *)q, sixteen_dst_bytes);+ p += 8;+ q += 16;+ }+ n -= p - p_begin;+ }+#endif while (n > 1) { *q++ = *p++; *q++ = c;
+ tests/LazyHClose.hs view
@@ -0,0 +1,64 @@+module Main (main) where++import Control.Monad (void, forM_)+import Data.ByteString.Internal (toForeignPtr)+import Foreign.C.String (withCString)+import Foreign.ForeignPtr (finalizeForeignPtr)+import System.IO (openFile, openTempFile, hClose, hPutStrLn, IOMode(..))+import System.Posix.Internals (c_unlink)++import qualified Data.ByteString as S+import qualified Data.ByteString.Char8 as S8+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.Char8 as L8++main :: IO ()+main = do+ let n = 1000+ (fn, h) <- openTempFile "." "lazy-hclose-test.tmp"+ hPutStrLn h "x"+ hClose h++ ------------------------------------------------------------------------+ -- readFile tests++ putStrLn "Testing resource leaks for Strict.readFile"+ forM_ [1..n] $ const $ do+ r <- S.readFile fn+ appendFile fn "" -- will fail, if fn has not been closed yet++ putStrLn "Testing resource leaks for Lazy.readFile"+ forM_ [1..n] $ const $ do+ r <- L.readFile fn+ L.length r `seq` return ()+ appendFile fn "" -- will fail, if fn has not been closed yet++ -- manage the resources explicitly.+ putStrLn "Testing resource leaks when converting lazy to strict"+ forM_ [1..n] $ const $ do+ let release c = finalizeForeignPtr fp where (fp,_,_) = toForeignPtr c+ r <- L.readFile fn+ mapM_ release (L.toChunks r)+ appendFile fn "" -- will fail, if fn has not been closed yet++ ------------------------------------------------------------------------+ -- hGetContents tests++ putStrLn "Testing strict hGetContents"+ forM_ [1..n] $ const $ do+ h <- openFile fn ReadMode+ r <- S.hGetContents h+ S.last r `seq` return ()+ appendFile fn "" -- will fail, if fn has not been closed yet++ putStrLn "Testing lazy hGetContents"+ forM_ [1..n] $ const $ do+ h <- openFile fn ReadMode+ r <- L.hGetContents h+ L.last r `seq` return ()+ appendFile fn "" -- will fail, if fn has not been closed yet++ removeFile fn++removeFile :: String -> IO ()+removeFile fn = void $ withCString fn c_unlink
+ tests/Properties.hs view
@@ -0,0 +1,2556 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+--+-- Must have rules off, otherwise the rewrite rules will replace the rhs+-- with the lhs, and we only end up testing lhs == lhs+--++--+-- -fhpc interferes with rewrite rules firing.+--++import Foreign.C.String (withCString)+import Foreign.Storable+import Foreign.ForeignPtr+import Foreign.Marshal.Alloc+import Foreign.Marshal.Array+import GHC.Ptr+import Test.Tasty.QuickCheck+import Control.Applicative+import Control.Monad+import Control.Concurrent+import Control.Exception+import System.Posix.Internals (c_unlink)++import Data.List+import Data.Char+import Data.Word+import Data.Maybe+import Data.Int (Int64)+import Data.Monoid+#if MIN_VERSION_base(4,9,0)+import Data.Semigroup+#endif+import GHC.Exts (Int(..), newPinnedByteArray#, unsafeFreezeByteArray#)+import GHC.ST (ST(..), runST)++import Text.Printf+import Data.String++import System.Environment+import System.IO++import Data.ByteString.Lazy (ByteString(..), pack , unpack)+import qualified Data.ByteString.Lazy as L+import Data.ByteString.Lazy.Internal (ByteString(..))++import qualified Data.ByteString as P+import qualified Data.ByteString.Internal as P+import qualified Data.ByteString.Unsafe as P+import qualified Data.ByteString.Char8 as C+import qualified Data.ByteString.Short as Short++import qualified Data.ByteString.Lazy.Char8 as LC+import qualified Data.ByteString.Lazy.Char8 as D++import qualified Data.ByteString.Lazy.Internal as L+import Prelude hiding (abs)++import Rules+import QuickCheckUtils+import Test.Tasty+import Test.Tasty.QuickCheck++toInt64 :: Int -> Int64+toInt64 = fromIntegral++--+-- ByteString.Lazy.Char8 <=> ByteString.Char8+--++prop_concatCC = D.concat `eq1` C.concat+prop_nullCC = D.null `eq1` C.null+prop_reverseCC = D.reverse `eq1` C.reverse+prop_transposeCC = D.transpose `eq1` C.transpose+prop_groupCC = D.group `eq1` C.group+prop_groupByCC = D.groupBy `eq2` C.groupBy+prop_initsCC = D.inits `eq1` C.inits+prop_tailsCC = D.tails `eq1` C.tails+prop_allCC = D.all `eq2` C.all+prop_anyCC = D.any `eq2` C.any+prop_appendCC = D.append `eq2` C.append+prop_breakCC = D.break `eq2` C.break+prop_concatMapCC = forAll (sized $ \n -> resize (min 50 n) arbitrary) $+ D.concatMap `eq2` C.concatMap+prop_consCC = D.cons `eq2` C.cons+prop_consCC' = D.cons' `eq2` C.cons+prop_unconsCC = D.uncons `eq1` C.uncons+prop_unsnocCC = D.unsnoc `eq1` C.unsnoc+prop_countCC = D.count `eq2` ((toInt64 .) . C.count)+prop_dropCC = (D.drop . toInt64) `eq2` C.drop+prop_dropWhileCC = D.dropWhile `eq2` C.dropWhile+prop_filterCC = D.filter `eq2` C.filter+prop_findCC = D.find `eq2` C.find+prop_findIndexCC = D.findIndex `eq2` ((fmap toInt64 .) . C.findIndex)+prop_findIndexEndCC = D.findIndexEnd `eq2` ((fmap toInt64 .) . C.findIndexEnd)+prop_findIndicesCC = D.findIndices `eq2` ((fmap toInt64 .) . C.findIndices)+prop_isPrefixOfCC = D.isPrefixOf `eq2` C.isPrefixOf+prop_stripPrefixCC = D.stripPrefix `eq2` C.stripPrefix+prop_isSuffixOfCC = D.isSuffixOf `eq2` C.isSuffixOf+prop_stripSuffixCC = D.stripSuffix `eq2` C.stripSuffix+prop_mapCC = D.map `eq2` C.map+prop_replicateCC = forAll arbitrarySizedIntegral $+ (D.replicate . toInt64) `eq2` C.replicate+prop_snocCC = D.snoc `eq2` C.snoc+prop_spanCC = D.span `eq2` C.span+prop_splitCC = D.split `eq2` C.split+prop_splitAtCC = (D.splitAt . toInt64) `eq2` C.splitAt+prop_takeCC = (D.take . toInt64) `eq2` C.take+prop_takeWhileCC = D.takeWhile `eq2` C.takeWhile+prop_elemCC = D.elem `eq2` C.elem+prop_notElemCC = D.notElem `eq2` C.notElem+prop_elemIndexCC = D.elemIndex `eq2` ((fmap toInt64 .) . C.elemIndex)+prop_elemIndicesCC = D.elemIndices `eq2` ((fmap toInt64 .) . C.elemIndices)+prop_lengthCC = D.length `eq1` (toInt64 . C.length)++prop_headCC = D.head `eqnotnull1` C.head+prop_initCC = D.init `eqnotnull1` C.init+prop_lastCC = D.last `eqnotnull1` C.last+prop_maximumCC = D.maximum `eqnotnull1` C.maximum+prop_minimumCC = D.minimum `eqnotnull1` C.minimum+prop_tailCC = D.tail `eqnotnull1` C.tail+prop_foldl1CC = D.foldl1 `eqnotnull2` C.foldl1+prop_foldl1CC' = D.foldl1' `eqnotnull2` C.foldl1'+prop_foldr1CC = D.foldr1 `eqnotnull2` C.foldr1+prop_foldr1CC' = D.foldr1 `eqnotnull2` C.foldr1'+prop_scanlCC = D.scanl `eqnotnull3` C.scanl++prop_intersperseCC = D.intersperse `eq2` C.intersperse++prop_foldlCC = eq3+ (D.foldl :: (X -> Char -> X) -> X -> B -> X)+ (C.foldl :: (X -> Char -> X) -> X -> P -> X)+prop_foldlCC' = eq3+ (D.foldl' :: (X -> Char -> X) -> X -> B -> X)+ (C.foldl' :: (X -> Char -> X) -> X -> P -> X)+prop_foldrCC = eq3+ (D.foldr :: (Char -> X -> X) -> X -> B -> X)+ (C.foldr :: (Char -> X -> X) -> X -> P -> X)+prop_foldrCC' = eq3+ (D.foldr :: (Char -> X -> X) -> X -> B -> X)+ (C.foldr' :: (Char -> X -> X) -> X -> P -> X)+prop_mapAccumLCC = eq3+ (D.mapAccumL :: (X -> Char -> (X,Char)) -> X -> B -> (X, B))+ (C.mapAccumL :: (X -> Char -> (X,Char)) -> X -> P -> (X, P))++--prop_mapIndexedCC = D.mapIndexed `eq2` C.mapIndexed+--prop_mapIndexedPL = L.mapIndexed `eq2` P.mapIndexed++--prop_mapAccumL_mapIndexedBP =+-- P.mapIndexed `eq2`+-- (\k p -> snd $ P.mapAccumL (\i w -> (i+1, k i w)) (0::Int) p)++--+-- ByteString.Lazy <=> ByteString+--++prop_concatBP = forAll (sized $ \n -> resize (n `div` 2) arbitrary) $+ L.concat `eq1` P.concat+prop_nullBP = L.null `eq1` P.null+prop_reverseBP = L.reverse `eq1` P.reverse++prop_transposeBP = L.transpose `eq1` P.transpose+prop_groupBP = L.group `eq1` P.group+prop_groupByBP = L.groupBy `eq2` P.groupBy+prop_initsBP = L.inits `eq1` P.inits+prop_tailsBP = L.tails `eq1` P.tails+prop_allBP = L.all `eq2` P.all+prop_anyBP = L.any `eq2` P.any+prop_appendBP = L.append `eq2` P.append+prop_breakBP = L.break `eq2` P.break+prop_concatMapBP = forAll (sized $ \n -> resize (n `div` 4) arbitrary) $+ L.concatMap `eq2` P.concatMap+prop_consBP = L.cons `eq2` P.cons+prop_consBP' = L.cons' `eq2` P.cons+prop_unconsBP = L.uncons `eq1` P.uncons+prop_unsnocBP = L.unsnoc `eq1` P.unsnoc+prop_countBP = L.count `eq2` ((toInt64 .) . P.count)+prop_dropBP = (L.drop. toInt64) `eq2` P.drop+prop_dropWhileBP = L.dropWhile `eq2` P.dropWhile+prop_filterBP = L.filter `eq2` P.filter+prop_findBP = L.find `eq2` P.find+prop_findIndexBP = L.findIndex `eq2` ((fmap toInt64 .) . P.findIndex)+prop_findIndexEndBP = L.findIndexEnd `eq2` ((fmap toInt64 .) . P.findIndexEnd)+prop_findIndicesBP = L.findIndices `eq2` ((fmap toInt64 .) . P.findIndices)+prop_isPrefixOfBP = L.isPrefixOf `eq2` P.isPrefixOf+prop_stripPrefixBP = L.stripPrefix `eq2` P.stripPrefix+prop_isSuffixOfBP = L.isSuffixOf `eq2` P.isSuffixOf+prop_stripSuffixBP = L.stripSuffix `eq2` P.stripSuffix+prop_mapBP = L.map `eq2` P.map+prop_replicateBP = forAll arbitrarySizedIntegral $+ (L.replicate. toInt64) `eq2` P.replicate+prop_snocBP = L.snoc `eq2` P.snoc+prop_spanBP = L.span `eq2` P.span+prop_splitBP = L.split `eq2` P.split+prop_splitAtBP = (L.splitAt. toInt64) `eq2` P.splitAt+prop_takeBP = (L.take . toInt64) `eq2` P.take+prop_takeWhileBP = L.takeWhile `eq2` P.takeWhile+prop_elemBP = L.elem `eq2` P.elem+prop_notElemBP = L.notElem `eq2` P.notElem+prop_elemIndexBP = L.elemIndex `eq2` ((fmap toInt64 .) . P.elemIndex)+prop_elemIndexEndBP = L.elemIndexEnd `eq2` ((fmap toInt64 .) . P.elemIndexEnd)+prop_elemIndicesBP = L.elemIndices `eq2` ((fmap toInt64 .) . P.elemIndices)+prop_intersperseBP = L.intersperse `eq2` P.intersperse+prop_lengthBP = L.length `eq1` (toInt64 . P.length)+prop_readIntBP = D.readInt `eq1` C.readInt+prop_linesBP = D.lines `eq1` C.lines++-- double check:+-- Currently there's a bug in the lazy bytestring version of lines, this+-- catches it:+prop_linesNLBP = eq1 D.lines C.lines x+ where x = D.pack "one\ntwo\n\n\nfive\n\nseven\n"++prop_headBP = L.head `eqnotnull1` P.head+prop_initBP = L.init `eqnotnull1` P.init+prop_lastBP = L.last `eqnotnull1` P.last+prop_maximumBP = L.maximum `eqnotnull1` P.maximum+prop_minimumBP = L.minimum `eqnotnull1` P.minimum+prop_tailBP = L.tail `eqnotnull1` P.tail+prop_foldl1BP = L.foldl1 `eqnotnull2` P.foldl1+prop_foldl1BP' = L.foldl1' `eqnotnull2` P.foldl1'+prop_foldr1BP = L.foldr1 `eqnotnull2` P.foldr1+prop_foldr1BP' = L.foldr1 `eqnotnull2` P.foldr1'+prop_scanlBP = L.scanl `eqnotnull3` P.scanl+++prop_eqBP = eq2+ ((==) :: B -> B -> Bool)+ ((==) :: P -> P -> Bool)+prop_compareBP = eq2+ ((compare) :: B -> B -> Ordering)+ ((compare) :: P -> P -> Ordering)+prop_foldlBP = eq3+ (L.foldl :: (X -> W -> X) -> X -> B -> X)+ (P.foldl :: (X -> W -> X) -> X -> P -> X)+prop_foldlBP' = eq3+ (L.foldl' :: (X -> W -> X) -> X -> B -> X)+ (P.foldl' :: (X -> W -> X) -> X -> P -> X)+prop_foldrBP = eq3+ (L.foldr :: (W -> X -> X) -> X -> B -> X)+ (P.foldr :: (W -> X -> X) -> X -> P -> X)+prop_foldrBP' = eq3+ (L.foldr :: (W -> X -> X) -> X -> B -> X)+ (P.foldr' :: (W -> X -> X) -> X -> P -> X)+prop_mapAccumLBP = eq3+ (L.mapAccumL :: (X -> W -> (X,W)) -> X -> B -> (X, B))+ (P.mapAccumL :: (X -> W -> (X,W)) -> X -> P -> (X, P))++prop_unfoldrBP =+ forAll arbitrarySizedIntegral $+ eq3+ ((\n f a -> L.take (fromIntegral n) $+ L.unfoldr f a) :: Int -> (X -> Maybe (W,X)) -> X -> B)+ ((\n f a -> fst $+ P.unfoldrN n f a) :: Int -> (X -> Maybe (W,X)) -> X -> P)++prop_unfoldr2BP =+ forAll arbitrarySizedIntegral $ \n ->+ forAll arbitrarySizedIntegral $ \a ->+ eq2+ ((\n a -> P.take (n*100) $+ P.unfoldr (\x -> if x <= (n*100) then Just (fromIntegral x, x + 1) else Nothing) a)+ :: Int -> Int -> P)+ ((\n a -> fst $+ P.unfoldrN (n*100) (\x -> if x <= (n*100) then Just (fromIntegral x, x + 1) else Nothing) a)+ :: Int -> Int -> P)+ n a++prop_unfoldr2CP =+ forAll arbitrarySizedIntegral $ \n ->+ forAll arbitrarySizedIntegral $ \a ->+ eq2+ ((\n a -> C.take (n*100) $+ C.unfoldr (\x -> if x <= (n*100) then Just (chr (x `mod` 256), x + 1) else Nothing) a)+ :: Int -> Int -> P)+ ((\n a -> fst $+ C.unfoldrN (n*100) (\x -> if x <= (n*100) then Just (chr (x `mod` 256), x + 1) else Nothing) a)+ :: Int -> Int -> P)+ n a+++prop_unfoldrLC =+ forAll arbitrarySizedIntegral $+ eq3+ ((\n f a -> LC.take (fromIntegral n) $+ LC.unfoldr f a) :: Int -> (X -> Maybe (Char,X)) -> X -> B)+ ((\n f a -> fst $+ C.unfoldrN n f a) :: Int -> (X -> Maybe (Char,X)) -> X -> P)++prop_cycleLC a =+ not (LC.null a) ==>+ forAll arbitrarySizedIntegral $+ eq1+ ((\n -> LC.take (fromIntegral n) $+ LC.cycle a+ ) :: Int -> B)++ ((\n -> LC.take (fromIntegral (n::Int)) . LC.concat $+ unfoldr (\x -> Just (x,x) ) a+ ) :: Int -> B)+++prop_iterateLC :: Int -> (Char8 -> Char8) -> Char8 -> Bool+prop_iterateLC n f (Char8 c) =+ eq3+ (\n f a -> LC.take (fromIntegral n) $ LC.iterate f a)+ (\n f a -> fst $ C.unfoldrN n (\a -> Just (f a, f a)) a)+ n+ (castFn f :: Char -> Char)+ c++prop_iterateLC_2 :: Int -> (Char8 -> Char8) -> Char8 -> Bool+prop_iterateLC_2 n f (Char8 c) =+ eq3+ (\n f a -> LC.take (fromIntegral (n :: Int)) $ LC.iterate f a)+ (\n f a -> LC.take (fromIntegral (n :: Int)) $ LC.unfoldr (\a -> Just (f a, f a)) a)+ n+ (castFn f :: Char -> Char)+ c++prop_iterateL =+ forAll arbitrarySizedIntegral $+ eq3+ ((\n f a -> L.take (fromIntegral n) $+ L.iterate f a) :: Int -> (W -> W) -> W -> B)+ ((\n f a -> fst $+ P.unfoldrN n (\a -> Just (f a, f a)) a) :: Int -> (W -> W) -> W -> P)++prop_repeatLC =+ forAll arbitrarySizedIntegral $+ eq2+ ((\n a -> LC.take (fromIntegral n) $+ LC.repeat a) :: Int -> Char -> B)+ ((\n a -> fst $+ C.unfoldrN n (\a -> Just (a, a)) a) :: Int -> Char -> P)++prop_repeatL =+ forAll arbitrarySizedIntegral $+ eq2+ ((\n a -> L.take (fromIntegral n) $+ L.repeat a) :: Int -> W -> B)+ ((\n a -> fst $+ P.unfoldrN n (\a -> Just (a, a)) a) :: Int -> W -> P)++--+-- properties comparing ByteString.Lazy `eq1` List+--++prop_concatBL = forAll (sized $ \n -> resize (n `div` 2) arbitrary) $+ L.concat `eq1` (concat :: [[W]] -> [W])+prop_lengthBL = L.length `eq1` (toInt64 . length :: [W] -> Int64)+prop_nullBL = L.null `eq1` (null :: [W] -> Bool)+prop_reverseBL = L.reverse `eq1` (reverse :: [W] -> [W])+prop_transposeBL = L.transpose `eq1` (transpose :: [[W]] -> [[W]])+prop_groupBL = L.group `eq1` (group :: [W] -> [[W]])+prop_groupByBL = L.groupBy `eq2` (groupBy :: (W -> W -> Bool) -> [W] -> [[W]])+prop_initsBL = L.inits `eq1` (inits :: [W] -> [[W]])+prop_tailsBL = L.tails `eq1` (tails :: [W] -> [[W]])+prop_allBL = L.all `eq2` (all :: (W -> Bool) -> [W] -> Bool)+prop_anyBL = L.any `eq2` (any :: (W -> Bool) -> [W] -> Bool)+prop_appendBL = L.append `eq2` ((++) :: [W] -> [W] -> [W])+prop_breakBL = L.break `eq2` (break :: (W -> Bool) -> [W] -> ([W],[W]))+prop_concatMapBL = forAll (sized $ \n -> resize (n `div` 2) arbitrary) $+ L.concatMap `eq2` (concatMap :: (W -> [W]) -> [W] -> [W])+prop_consBL = L.cons `eq2` ((:) :: W -> [W] -> [W])+prop_dropBL = (L.drop . toInt64) `eq2` (drop :: Int -> [W] -> [W])+prop_dropWhileBL = L.dropWhile `eq2` (dropWhile :: (W -> Bool) -> [W] -> [W])+prop_filterBL = L.filter `eq2` (filter :: (W -> Bool ) -> [W] -> [W])+prop_findBL = L.find `eq2` (find :: (W -> Bool) -> [W] -> Maybe W)+prop_findIndicesBL = L.findIndices `eq2` ((fmap toInt64 .) . findIndices:: (W -> Bool) -> [W] -> [Int64])+prop_findIndexBL = L.findIndex `eq2` ((fmap toInt64 .) . findIndex :: (W -> Bool) -> [W] -> Maybe Int64)+prop_findIndexEndBL = L.findIndexEnd `eq2` ((fmap toInt64 .) . findIndexEnd :: (W -> Bool) -> [W] -> Maybe Int64)+prop_isPrefixOfBL = L.isPrefixOf `eq2` (isPrefixOf:: [W] -> [W] -> Bool)+prop_stripPrefixBL = L.stripPrefix `eq2` (stripPrefix:: [W] -> [W] -> Maybe [W])+prop_isSuffixOfBL = L.isSuffixOf `eq2` (isSuffixOf:: [W] -> [W] -> Bool)+prop_stripSuffixBL = L.stripSuffix `eq2` (stripSuffix :: [W] -> [W] -> Maybe [W])+prop_mapBL = L.map `eq2` (map :: (W -> W) -> [W] -> [W])+prop_replicateBL = forAll arbitrarySizedIntegral $+ (L.replicate . toInt64) `eq2` (replicate :: Int -> W -> [W])+prop_snocBL = L.snoc `eq2` ((\xs x -> xs ++ [x]) :: [W] -> W -> [W])+prop_spanBL = L.span `eq2` (span :: (W -> Bool) -> [W] -> ([W],[W]))+prop_splitAtBL = (L.splitAt . toInt64) `eq2` (splitAt :: Int -> [W] -> ([W],[W]))+prop_takeBL = (L.take . toInt64) `eq2` (take :: Int -> [W] -> [W])+prop_takeWhileBL = L.takeWhile `eq2` (takeWhile :: (W -> Bool) -> [W] -> [W])+prop_elemBL = L.elem `eq2` (elem :: W -> [W] -> Bool)+prop_notElemBL = L.notElem `eq2` (notElem :: W -> [W] -> Bool)+prop_elemIndexBL = L.elemIndex `eq2` ((fmap toInt64 .) . elemIndex :: W -> [W] -> Maybe Int64)+prop_elemIndexEndBL = L.elemIndexEnd `eq2` ((fmap toInt64 .) . elemIndexEnd:: W -> [W] -> Maybe Int64)+prop_elemIndicesBL = L.elemIndices `eq2` ((fmap toInt64 .) . elemIndices :: W -> [W] -> [Int64])+prop_linesBL = D.lines `eq1` (lines :: String -> [String])++prop_foldl1BL = L.foldl1 `eqnotnull2` (foldl1 :: (W -> W -> W) -> [W] -> W)+prop_foldl1BL' = L.foldl1' `eqnotnull2` (foldl1' :: (W -> W -> W) -> [W] -> W)+prop_foldr1BL = L.foldr1 `eqnotnull2` (foldr1 :: (W -> W -> W) -> [W] -> W)+prop_headBL = L.head `eqnotnull1` (head :: [W] -> W)+prop_initBL = L.init `eqnotnull1` (init :: [W] -> [W])+prop_lastBL = L.last `eqnotnull1` (last :: [W] -> W)+prop_maximumBL = L.maximum `eqnotnull1` (maximum :: [W] -> W)+prop_minimumBL = L.minimum `eqnotnull1` (minimum :: [W] -> W)+prop_tailBL = L.tail `eqnotnull1` (tail :: [W] -> [W])++prop_eqBL = eq2+ ((==) :: B -> B -> Bool)+ ((==) :: [W] -> [W] -> Bool)+prop_compareBL = eq2+ ((compare) :: B -> B -> Ordering)+ ((compare) :: [W] -> [W] -> Ordering)+prop_foldlBL = eq3+ (L.foldl :: (X -> W -> X) -> X -> B -> X)+ ( foldl :: (X -> W -> X) -> X -> [W] -> X)+prop_foldlBL' = eq3+ (L.foldl' :: (X -> W -> X) -> X -> B -> X)+ ( foldl' :: (X -> W -> X) -> X -> [W] -> X)+prop_foldrBL = eq3+ (L.foldr :: (W -> X -> X) -> X -> B -> X)+ ( foldr :: (W -> X -> X) -> X -> [W] -> X)+prop_mapAccumLBL = eq3+ (L.mapAccumL :: (X -> W -> (X,W)) -> X -> B -> (X, B))+ ( mapAccumL :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W]))++prop_mapAccumRBL = eq3+ (L.mapAccumR :: (X -> W -> (X,W)) -> X -> B -> (X, B))+ ( mapAccumR :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W]))++prop_mapAccumRDL :: (X -> Char8 -> (X, Char8)) -> X -> B -> Bool+prop_mapAccumRDL f = eq3+ (D.mapAccumR :: (X -> Char -> (X,Char)) -> X -> B -> (X, B))+ ( mapAccumR :: (X -> Char -> (X,Char)) -> X -> [Char] -> (X, [Char]))+ (castFn f)++prop_mapAccumRCC :: (X -> Char8 -> (X, Char8)) -> X -> P -> Bool+prop_mapAccumRCC f = eq3+ (C.mapAccumR :: (X -> Char -> (X,Char)) -> X -> P -> (X, P))+ ( mapAccumR :: (X -> Char -> (X,Char)) -> X -> [Char] -> (X, [Char]))+ (castFn f)++prop_unfoldrBL =+ forAll arbitrarySizedIntegral $+ eq3+ ((\n f a -> L.take (fromIntegral n) $+ L.unfoldr f a) :: Int -> (X -> Maybe (W,X)) -> X -> B)+ ((\n f a -> take n $+ unfoldr f a) :: Int -> (X -> Maybe (W,X)) -> X -> [W])++prop_packZipWithBL = L.packZipWith `eq3` (zipWith :: (W -> W -> W) -> [W] -> [W] -> [W])++--+-- And finally, check correspondance between Data.ByteString and List+--++prop_lengthPL = (fromIntegral.P.length :: P -> Int) `eq1` (length :: [W] -> Int)+prop_nullPL = P.null `eq1` (null :: [W] -> Bool)+prop_reversePL = P.reverse `eq1` (reverse :: [W] -> [W])+prop_transposePL = P.transpose `eq1` (transpose :: [[W]] -> [[W]])+prop_groupPL = P.group `eq1` (group :: [W] -> [[W]])+prop_groupByPL = P.groupBy `eq2` (groupBy :: (W -> W -> Bool) -> [W] -> [[W]])+prop_initsPL = P.inits `eq1` (inits :: [W] -> [[W]])+prop_tailsPL = P.tails `eq1` (tails :: [W] -> [[W]])+prop_concatPL = forAll (sized $ \n -> resize (n `div` 2) arbitrary) $+ P.concat `eq1` (concat :: [[W]] -> [W])+prop_allPL = P.all `eq2` (all :: (W -> Bool) -> [W] -> Bool)+prop_anyPL = P.any `eq2` (any :: (W -> Bool) -> [W] -> Bool)+prop_appendPL = P.append `eq2` ((++) :: [W] -> [W] -> [W])+prop_breakPL = P.break `eq2` (break :: (W -> Bool) -> [W] -> ([W],[W]))+prop_concatMapPL = forAll (sized $ \n -> resize (n `div` 2) arbitrary) $+ P.concatMap `eq2` (concatMap :: (W -> [W]) -> [W] -> [W])+prop_consPL = P.cons `eq2` ((:) :: W -> [W] -> [W])+prop_dropPL = P.drop `eq2` (drop :: Int -> [W] -> [W])+prop_dropWhilePL = P.dropWhile `eq2` (dropWhile :: (W -> Bool) -> [W] -> [W])+prop_filterPL = P.filter `eq2` (filter :: (W -> Bool ) -> [W] -> [W])+prop_filterPL_rule= (\x -> P.filter ((==) x)) `eq2` -- test rules+ ((\x -> filter ((==) x)) :: W -> [W] -> [W])++-- under lambda doesn't fire?+prop_filterLC_rule= (f) `eq2` -- test rules+ ((\x -> filter ((==) x)) :: Char -> [Char] -> [Char])+ where+ f x s = LC.filter ((==) x) s++prop_partitionPL = P.partition `eq2` (partition :: (W -> Bool ) -> [W] -> ([W],[W]))+prop_partitionLL = L.partition `eq2` (partition :: (W -> Bool ) -> [W] -> ([W],[W]))+prop_findPL = P.find `eq2` (find :: (W -> Bool) -> [W] -> Maybe W)+prop_findIndexPL = P.findIndex `eq2` (findIndex :: (W -> Bool) -> [W] -> Maybe Int)+prop_findIndexEndPL = P.findIndexEnd `eq2` (findIndexEnd :: (W -> Bool) -> [W] -> Maybe Int)+prop_isPrefixOfPL = P.isPrefixOf`eq2` (isPrefixOf:: [W] -> [W] -> Bool)+prop_isSuffixOfPL = P.isSuffixOf`eq2` (isSuffixOf:: [W] -> [W] -> Bool)+prop_isInfixOfPL = P.isInfixOf `eq2` (isInfixOf:: [W] -> [W] -> Bool)+prop_stripPrefixPL = P.stripPrefix`eq2` (stripPrefix:: [W] -> [W] -> Maybe [W])+prop_stripSuffixPL = P.stripSuffix`eq2` (stripSuffix:: [W] -> [W] -> Maybe [W])+prop_mapPL = P.map `eq2` (map :: (W -> W) -> [W] -> [W])+prop_replicatePL = forAll arbitrarySizedIntegral $+ P.replicate `eq2` (replicate :: Int -> W -> [W])+prop_snocPL = P.snoc `eq2` ((\xs x -> xs ++ [x]) :: [W] -> W -> [W])+prop_spanPL = P.span `eq2` (span :: (W -> Bool) -> [W] -> ([W],[W]))+prop_splitAtPL = P.splitAt `eq2` (splitAt :: Int -> [W] -> ([W],[W]))+prop_takePL = P.take `eq2` (take :: Int -> [W] -> [W])+prop_takeWhilePL = P.takeWhile `eq2` (takeWhile :: (W -> Bool) -> [W] -> [W])+prop_elemPL = P.elem `eq2` (elem :: W -> [W] -> Bool)+prop_notElemPL = P.notElem `eq2` (notElem :: W -> [W] -> Bool)+prop_elemIndexPL = P.elemIndex `eq2` (elemIndex :: W -> [W] -> Maybe Int)+prop_linesPL = C.lines `eq1` (lines :: String -> [String])+prop_findIndicesPL= P.findIndices`eq2` (findIndices:: (W -> Bool) -> [W] -> [Int])+prop_elemIndicesPL= P.elemIndices`eq2` (elemIndices:: W -> [W] -> [Int])+prop_zipPL = P.zip `eq2` (zip :: [W] -> [W] -> [(W,W)])+prop_zipCL = C.zip `eq2` (zip :: [Char] -> [Char] -> [(Char,Char)])+prop_zipLL = L.zip `eq2` (zip :: [W] -> [W] -> [(W,W)])+prop_unzipPL = P.unzip `eq1` (unzip :: [(W,W)] -> ([W],[W]))+prop_unzipLL = L.unzip `eq1` (unzip :: [(W,W)] -> ([W],[W]))++prop_unzipCL :: [(Char8, Char8)] -> Bool+prop_unzipCL xs = (C.unzip `eq1` (unzip :: [(Char,Char)] -> ([Char],[Char])))+ [ (a,b) | (Char8 a, Char8 b) <- xs ]++prop_unzipDL :: [(Char8, Char8)] -> Bool+prop_unzipDL xs = (D.unzip `eq1` (unzip :: [(Char,Char)] -> ([Char],[Char])))+ [ (a,b) | (Char8 a, Char8 b) <- xs ]++prop_foldl1PL = P.foldl1 `eqnotnull2` (foldl1 :: (W -> W -> W) -> [W] -> W)+prop_foldl1PL' = P.foldl1' `eqnotnull2` (foldl1' :: (W -> W -> W) -> [W] -> W)+prop_foldr1PL = P.foldr1 `eqnotnull2` (foldr1 :: (W -> W -> W) -> [W] -> W)+prop_scanlPL = P.scanl `eqnotnull3` (scanl :: (W -> W -> W) -> W -> [W] -> [W])+prop_scanl1PL = P.scanl1 `eqnotnull2` (scanl1 :: (W -> W -> W) -> [W] -> [W])+prop_scanrPL = P.scanr `eqnotnull3` (scanr :: (W -> W -> W) -> W -> [W] -> [W])+prop_scanr1PL = P.scanr1 `eqnotnull2` (scanr1 :: (W -> W -> W) -> [W] -> [W])+prop_headPL = P.head `eqnotnull1` (head :: [W] -> W)+prop_initPL = P.init `eqnotnull1` (init :: [W] -> [W])+prop_lastPL = P.last `eqnotnull1` (last :: [W] -> W)+prop_maximumPL = P.maximum `eqnotnull1` (maximum :: [W] -> W)+prop_minimumPL = P.minimum `eqnotnull1` (minimum :: [W] -> W)+prop_tailPL = P.tail `eqnotnull1` (tail :: [W] -> [W])++prop_scanl1CL :: (Char8 -> Char8 -> Char8) -> P -> Property+prop_scanrCL :: (Char8 -> Char8 -> Char8) -> Char8 -> P -> Property+prop_scanr1CL :: (Char8 -> Char8 -> Char8) -> P -> Property++prop_scanl1CL f = eqnotnull2+ C.scanl1+ (scanl1 :: (Char -> Char -> Char) -> [Char] -> [Char])+ (castFn f)++prop_scanrCL f (Char8 c) = eqnotnull3+ C.scanr+ (scanr :: (Char -> Char -> Char) -> Char -> [Char] -> [Char])+ (castFn f)+ c++prop_scanr1CL f = eqnotnull2+ C.scanr1+ (scanr1 :: (Char -> Char -> Char) -> [Char] -> [Char])+ (castFn f)++prop_packZipWithPL = P.packZipWith `eq3` (zipWith :: (W -> W -> W) -> [W] -> [W] -> [W])++prop_zipWithPL = (P.zipWith :: (W -> W -> X) -> P -> P -> [X]) `eq3`+ (zipWith :: (W -> W -> X) -> [W] -> [W] -> [X])++prop_zipWithPL_rules = (P.zipWith :: (W -> W -> W) -> P -> P -> [W]) `eq3`+ (zipWith :: (W -> W -> W) -> [W] -> [W] -> [W])++prop_eqPL = eq2+ ((==) :: P -> P -> Bool)+ ((==) :: [W] -> [W] -> Bool)+prop_comparePL = eq2+ ((compare) :: P -> P -> Ordering)+ ((compare) :: [W] -> [W] -> Ordering)+prop_foldlPL = eq3+ (P.foldl :: (X -> W -> X) -> X -> P -> X)+ ( foldl :: (X -> W -> X) -> X -> [W] -> X)+prop_foldlPL' = eq3+ (P.foldl' :: (X -> W -> X) -> X -> P -> X)+ ( foldl' :: (X -> W -> X) -> X -> [W] -> X)+prop_foldrPL = eq3+ (P.foldr :: (W -> X -> X) -> X -> P -> X)+ ( foldr :: (W -> X -> X) -> X -> [W] -> X)+prop_mapAccumLPL= eq3+ (P.mapAccumL :: (X -> W -> (X,W)) -> X -> P -> (X, P))+ ( mapAccumL :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W]))+prop_mapAccumRPL= eq3+ (P.mapAccumR :: (X -> W -> (X,W)) -> X -> P -> (X, P))+ ( mapAccumR :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W]))+prop_unfoldrPL =+ forAll arbitrarySizedIntegral $+ eq3+ ((\n f a -> fst $+ P.unfoldrN n f a) :: Int -> (X -> Maybe (W,X)) -> X -> P)+ ((\n f a -> take n $+ unfoldr f a) :: Int -> (X -> Maybe (W,X)) -> X -> [W])++------------------------------------------------------------------------+--+-- These are miscellaneous tests left over. Or else they test some+-- property internal to a type (i.e. head . sort == minimum), without+-- reference to a model type.+--++invariant :: L.ByteString -> Bool+invariant Empty = True+invariant (Chunk c cs) = not (P.null c) && invariant cs++prop_invariant = invariant++prop_eq_refl x = x == (x :: ByteString)+prop_eq_symm x y = (x == y) == (y == (x :: ByteString))++prop_eq1 xs = xs == (unpack . pack $ xs)+prop_eq2 xs = xs == (xs :: ByteString)+prop_eq3 xs ys = (xs == ys) == (unpack xs == unpack ys)++prop_compare1 xs = (pack xs `compare` pack xs) == EQ+prop_compare2 xs c = (pack (xs++[c]) `compare` pack xs) == GT+prop_compare3 xs c = (pack xs `compare` pack (xs++[c])) == LT++prop_compare4 xs = (not (null xs)) ==> (pack xs `compare` L.empty) == GT+prop_compare5 xs = (not (null xs)) ==> (L.empty `compare` pack xs) == LT+prop_compare6 xs ys = (not (null ys)) ==> (pack (xs++ys) `compare` pack xs) == GT++prop_compare7 x y = x `compare` y == (L.singleton x `compare` L.singleton y)+prop_compare8 xs ys = xs `compare` ys == (L.pack xs `compare` L.pack ys)+prop_compare9 = (L.singleton 255 `compare` L.singleton 127) == GT++prop_compare7LL (Char8 x) (Char8 y) =+ x `compare` y == (LC.singleton x `compare` LC.singleton y)++prop_empty1 = L.length L.empty == 0+prop_empty2 = L.unpack L.empty == []++prop_packunpack s = (L.unpack . L.pack) s == id s+prop_unpackpack s = (L.pack . L.unpack) s == id s++prop_null xs = null (L.unpack xs) == L.null xs++prop_length1 xs = fromIntegral (length xs) == L.length (L.pack xs)++prop_length2 xs = L.length xs == length1 xs+ where length1 ys+ | L.null ys = 0+ | otherwise = 1 + length1 (L.tail ys)++prop_cons1 c xs = unpack (L.cons c (pack xs)) == (c:xs)+prop_cons2 c = L.singleton c == (c `L.cons` L.empty)+prop_cons3 c = unpack (L.singleton c) == (c:[])+prop_cons4 c = (c `L.cons` L.empty) == pack (c:[])++prop_snoc1 xs c = xs ++ [c] == unpack ((pack xs) `L.snoc` c)++prop_head xs = (not (null xs)) ==> head xs == (L.head . pack) xs+prop_head1 xs = not (L.null xs) ==> L.head xs == head (L.unpack xs)++prop_tail xs = not (L.null xs) ==> L.tail xs == pack (tail (unpack xs))+prop_tail1 xs = (not (null xs)) ==> tail xs == (unpack . L.tail . pack) xs++prop_last xs = (not (null xs)) ==> last xs == (L.last . pack) xs++prop_init xs =+ (not (null xs)) ==>+ init xs == (unpack . L.init . pack) xs++prop_append1 xs = (xs ++ xs) == (unpack $ pack xs `L.append` pack xs)+prop_append2 xs ys = (xs ++ ys) == (unpack $ pack xs `L.append` pack ys)+prop_append3 xs ys = L.append xs ys == pack (unpack xs ++ unpack ys)+prop_appendLazy xs = L.head (L.pack [xs] `L.append` error "Tail should be lazy") == xs++prop_map1 f xs = L.map f (pack xs) == pack (map f xs)+prop_map2 f g xs = L.map f (L.map g xs) == L.map (f . g) xs+prop_map3 f xs = map f xs == (unpack . L.map f . pack) xs++prop_filter1 c xs = (filter (/=c) xs) == (unpack $ L.filter (/=c) (pack xs))+prop_filter2 p xs = (filter p xs) == (unpack $ L.filter p (pack xs))++prop_reverse xs = reverse xs == (unpack . L.reverse . pack) xs+prop_reverse1 xs = L.reverse (pack xs) == pack (reverse xs)+prop_reverse2 xs = reverse (unpack xs) == (unpack . L.reverse) xs++prop_transpose xs = (transpose xs) == ((map unpack) . L.transpose . (map pack)) xs++prop_foldl f c xs = L.foldl f c (pack xs) == foldl f c xs+ where _ = c :: Char++prop_foldr f c xs = L.foldl f c (pack xs) == foldl f c xs+ where _ = c :: Char++prop_foldl_1 xs = L.foldl (\xs c -> c `L.cons` xs) L.empty xs == L.reverse xs+prop_foldr_1 xs = L.foldr (\c xs -> c `L.cons` xs) L.empty xs == id xs++prop_foldl1_1 xs =+ (not . L.null) xs ==>+ L.foldl1 (\x c -> if c > x then c else x) xs ==+ L.foldl (\x c -> if c > x then c else x) 0 xs++prop_foldl1_2 xs =+ (not . L.null) xs ==>+ L.foldl1 const xs == L.head xs++prop_foldl1_3 xs =+ (not . L.null) xs ==>+ L.foldl1 (flip const) xs == L.last xs++prop_foldr1_1 xs =+ (not . L.null) xs ==>+ L.foldr1 (\c x -> if c > x then c else x) xs ==+ L.foldr (\c x -> if c > x then c else x) 0 xs++prop_foldr1_2 xs =+ (not . L.null) xs ==>+ L.foldr1 (flip const) xs == L.last xs++prop_foldr1_3 xs =+ (not . L.null) xs ==>+ L.foldr1 const xs == L.head xs++prop_concat1 xs = (concat [xs,xs]) == (unpack $ L.concat [pack xs, pack xs])+prop_concat2 xs = (concat [xs,[]]) == (unpack $ L.concat [pack xs, pack []])+prop_concat3 = forAll (sized $ \n -> resize (n `div` 2) arbitrary) $ \xss ->+ L.concat (map pack xss) == pack (concat xss)++prop_concatMap xs = L.concatMap L.singleton xs == (pack . concatMap (:[]) . unpack) xs++prop_any xs a = (any (== a) xs) == (L.any (== a) (pack xs))+prop_all xs a = (all (== a) xs) == (L.all (== a) (pack xs))++prop_maximum xs = (not (null xs)) ==> (maximum xs) == (L.maximum ( pack xs ))+prop_minimum xs = (not (null xs)) ==> (minimum xs) == (L.minimum ( pack xs ))++prop_compareLength1 xs = (L.pack xs `L.compareLength` fromIntegral (length xs)) == EQ+prop_compareLength2 xs c = (L.pack (xs ++ [c]) `L.compareLength` fromIntegral (length xs)) == GT+prop_compareLength3 xs c = (L.pack xs `L.compareLength` fromIntegral (length (xs ++ [c]))) == LT+prop_compareLength4 xs c = ((L.pack xs `L.append` L.pack [c] `L.append` L.pack [undefined])+ `L.compareLength` fromIntegral (length xs)) == GT+prop_compareLength5 xs l = L.compareLength xs l == compare (L.length xs) l++prop_replicate1 c =+ forAll arbitrary $ \(Positive n) ->+ unpack (L.replicate (fromIntegral n) c) == replicate n c++prop_replicate2 c = unpack (L.replicate 0 c) == replicate 0 c++prop_take1 i xs = L.take (fromIntegral i) (pack xs) == pack (take i xs)+prop_takeEnd i xs = P.takeEnd i xs == P.drop (P.length xs - i) xs++prop_drop1 i xs = L.drop (fromIntegral i) (pack xs) == pack (drop i xs)+prop_dropEnd i xs = P.dropEnd i xs == P.take (P.length xs - i) xs++prop_splitAt i xs = --collect (i >= 0 && i < length xs) $+ L.splitAt (fromIntegral i) (pack xs) == let (a,b) = splitAt i xs in (pack a, pack b)++prop_takeWhile f xs = L.takeWhile f (pack xs) == pack (takeWhile f xs)+prop_dropWhile f xs = L.dropWhile f (pack xs) == pack (dropWhile f xs)+prop_takeWhileEnd f = P.takeWhileEnd f `eq1` (P.reverse . P.takeWhile f . P.reverse)+prop_dropWhileEnd f = P.dropWhileEnd f `eq1` (P.reverse . P.dropWhile f . P.reverse)++prop_break f xs = L.break f (pack xs) ==+ let (a,b) = break f xs in (pack a, pack b)++prop_breakspan xs c = L.break (==c) xs == L.span (/=c) xs++prop_span xs a = (span (/=a) xs) == (let (x,y) = L.span (/=a) (pack xs) in (unpack x, unpack y))++prop_split c xs = (map L.unpack . map checkInvariant . L.split c $ xs)+ == (map P.unpack . P.split c . P.pack . L.unpack $ xs)++prop_splitWith_empty f = L.splitWith f mempty == []++prop_splitWith f xs = (l1 == l2 || l1 == l2+1) &&+ sum (map L.length splits) == L.length xs - l2+ where splits = L.splitWith f xs+ l1 = fromIntegral (length splits)+ l2 = L.length (L.filter f xs)++prop_splitWith_D_empty f = D.splitWith f mempty == []++prop_splitWith_D f xs = (l1 == l2 || l1 == l2+1) &&+ sum (map D.length splits) == D.length xs - l2+ where splits = D.splitWith f xs+ l1 = fromIntegral (length splits)+ l2 = D.length (D.filter f xs)++prop_splitWith_C_empty f = C.splitWith f mempty == []++prop_splitWith_C f xs = (l1 == l2 || l1 == l2+1) &&+ sum (map C.length splits) == C.length xs - l2+ where splits = C.splitWith f xs+ l1 = fromIntegral (length splits)+ l2 = C.length (C.filter f xs)++prop_split_empty c = L.split c mempty == []++prop_joinsplit c xs = L.intercalate (pack [c]) (L.split c xs) == id xs++prop_group xs = group xs == (map unpack . L.group . pack) xs+prop_groupBy f xs = groupBy f xs == (map unpack . L.groupBy f . pack) xs++prop_groupBy_LC :: (Char8 -> Char8 -> Bool) -> String8 -> Bool+prop_groupBy_LC f' (String8 xs) =+ groupBy f xs == (map LC.unpack . LC.groupBy f . LC.pack) xs+ where+ f :: Char -> Char -> Bool+ f = castFn f'++-- prop_joinjoinByte xs ys c = L.joinWithByte c xs ys == L.join (L.singleton c) [xs,ys]++prop_index xs =+ not (null xs) ==>+ forAll indices $ \i -> (xs !! i) == L.pack xs `L.index` (fromIntegral i)+ where indices = choose (0, length xs -1)++prop_index_D (String8 xs) =+ not (null xs) ==>+ forAll indices $ \i -> (xs !! i) == D.pack xs `D.index` (fromIntegral i)+ where indices = choose (0, length xs -1)++prop_index_C (String8 xs) =+ not (null xs) ==>+ forAll indices $ \i -> (xs !! i) == C.pack xs `C.index` (fromIntegral i)+ where indices = choose (0, length xs -1)++-- | Test 'indexMaybe' for Lazy and Strict 'ByteString's.+-- If we are testing within the bounds it should return a 'Just' value.+-- If we are testing outside of the bounds it should return a 'Nothing' value.+prop_indexMaybe_Just_L xs =+ not (null xs) ==>+ forAll indices $ \i -> isJust (ys `L.indexMaybe` (fromIntegral i))+ where+ ys = L.pack xs+ indices = choose (0, length xs -1)++prop_indexMaybe_Just_P xs =+ not (null xs) ==>+ forAll indices $ \i -> isJust (ys `P.indexMaybe` (fromIntegral i))+ where+ ys = P.pack xs+ indices = choose (0, length xs -1)++prop_indexMaybe_Nothing_L xs =+ not (null xs) ==>+ forAll indices $ \i -> isNothing (ys `L.indexMaybe` (fromIntegral i))+ where+ ys = L.pack xs+ outOfBounds = choose (-100, length xs + 100)+ indices = suchThat outOfBounds (\n -> n < 0 || n >= length xs)++prop_indexMaybe_Nothing_P xs =+ not (null xs) ==>+ forAll indices $ \i -> isNothing (ys `P.indexMaybe` (fromIntegral i))+ where+ ys = P.pack xs+ outOfBounds = choose (-100, length xs + 100)+ indices = suchThat outOfBounds (\n -> n < 0 || n >= length xs)++prop_elemIndex xs c = (elemIndex c xs) == fmap fromIntegral (L.elemIndex c (pack xs))++prop_elemIndexCL :: String8 -> Char8 -> Bool+prop_elemIndexCL (String8 xs) (Char8 c) =+ (elemIndex c xs) == (C.elemIndex c (C.pack xs))++prop_elemIndices xs c = elemIndices c xs == map fromIntegral (L.elemIndices c (pack xs))++prop_count c xs = length (L.elemIndices c xs) == fromIntegral (L.count c xs)++prop_findIndex xs f = (findIndex f xs) == fmap fromIntegral (L.findIndex f (pack xs))+prop_findIndexEnd xs f = (findIndexEnd f xs) == fmap fromIntegral (L.findIndexEnd f (pack xs))+prop_findIndicies xs f = (findIndices f xs) == map fromIntegral (L.findIndices f (pack xs))++prop_elem xs c = (c `elem` xs) == (c `L.elem` (pack xs))+prop_notElem xs c = (c `notElem` xs) == (L.notElem c (pack xs))+prop_elem_notelem xs c = c `L.elem` xs == not (c `L.notElem` xs)++-- prop_filterByte xs c = L.filterByte c xs == L.filter (==c) xs+-- prop_filterByte2 xs c = unpack (L.filterByte c xs) == filter (==c) (unpack xs)++-- prop_filterNotByte xs c = L.filterNotByte c xs == L.filter (/=c) xs+-- prop_filterNotByte2 xs c = unpack (L.filterNotByte c xs) == filter (/=c) (unpack xs)++prop_find p xs = find p xs == L.find p (pack xs)++prop_find_findIndex p xs =+ L.find p xs == case L.findIndex p xs of+ Just n -> Just (xs `L.index` n)+ _ -> Nothing++prop_isPrefixOf xs ys = isPrefixOf xs ys == (pack xs `L.isPrefixOf` pack ys)+prop_stripPrefix xs ys = (pack <$> stripPrefix xs ys) == (pack xs `L.stripPrefix` pack ys)++prop_isSuffixOf xs ys = isSuffixOf xs ys == (pack xs `L.isSuffixOf` pack ys)+prop_stripSuffix xs ys = (pack <$> stripSuffix xs ys) == (pack xs `L.stripSuffix` pack ys)++{-+prop_sort1 xs = sort xs == (unpack . L.sort . pack) xs+prop_sort2 xs = (not (null xs)) ==> (L.head . L.sort . pack $ xs) == minimum xs+prop_sort3 xs = (not (null xs)) ==> (L.last . L.sort . pack $ xs) == maximum xs+prop_sort4 xs ys =+ (not (null xs)) ==>+ (not (null ys)) ==>+ (L.head . L.sort) (L.append (pack xs) (pack ys)) == min (minimum xs) (minimum ys)++prop_sort5 xs ys =+ (not (null xs)) ==>+ (not (null ys)) ==>+ (L.last . L.sort) (L.append (pack xs) (pack ys)) == max (maximum xs) (maximum ys)++-}++------------------------------------------------------------------------+-- Misc ByteString properties++prop_nil1BB = P.length P.empty == 0+prop_nil2BB = P.unpack P.empty == []+prop_nil1BB_monoid = P.length mempty == 0+prop_nil2BB_monoid = P.unpack mempty == []++prop_nil1LL_monoid = L.length mempty == 0+prop_nil2LL_monoid = L.unpack mempty == []++prop_tailSBB xs = not (P.null xs) ==> P.tail xs == P.pack (tail (P.unpack xs))++prop_nullBB xs = null (P.unpack xs) == P.null xs++prop_lengthBB xs = P.length xs == length1 xs+ where+ length1 ys+ | P.null ys = 0+ | otherwise = 1 + length1 (P.tail ys)++prop_lengthSBB xs = length xs == P.length (P.pack xs)++prop_indexBB xs =+ not (null xs) ==>+ forAll indices $ \i -> (xs !! i) == P.pack xs `P.index` i+ where indices = choose (0, length xs -1)++prop_unsafeIndexBB xs =+ not (null xs) ==>+ forAll indices $ \i -> (xs !! i) == P.pack xs `P.unsafeIndex` i+ where indices = choose (0, length xs -1)++prop_mapfusionBB f g xs = P.map f (P.map g xs) == P.map (f . g) xs++prop_filterBB f xs = P.filter f (P.pack xs) == P.pack (filter f xs)++prop_filterfusionBB f g xs = P.filter f (P.filter g xs) == P.filter (\c -> f c && g c) xs++prop_elemSBB x xs = P.elem x (P.pack xs) == elem x xs++prop_takeSBB i xs = P.take i (P.pack xs) == P.pack (take i xs)+prop_dropSBB i xs = P.drop i (P.pack xs) == P.pack (drop i xs)++prop_splitAtSBB i xs = -- collect (i >= 0 && i < length xs) $+ P.splitAt i (P.pack xs) ==+ let (a,b) = splitAt i xs in (P.pack a, P.pack b)++prop_foldlBB f c xs = P.foldl f c (P.pack xs) == foldl f c xs+ where _ = c :: Char++prop_scanlfoldlBB f z xs = not (P.null xs) ==> P.last (P.scanl f z xs) == P.foldl f z xs++prop_foldrBB f c xs = P.foldl f c (P.pack xs) == foldl f c xs+ where _ = c :: Char++prop_takeWhileSBB f xs = P.takeWhile f (P.pack xs) == P.pack (takeWhile f xs)+prop_dropWhileSBB f xs = P.dropWhile f (P.pack xs) == P.pack (dropWhile f xs)++prop_spanSBB f xs = P.span f (P.pack xs) ==+ let (a,b) = span f xs in (P.pack a, P.pack b)++prop_breakSBB f xs = P.break f (P.pack xs) ==+ let (a,b) = break f xs in (P.pack a, P.pack b)++prop_breakspan_1BB xs c = P.break (== c) xs == P.span (/= c) xs++prop_linesSBB (String8 xs) = C.lines (C.pack xs) == map C.pack (lines xs)++prop_unlinesSBB xss = C.unlines (map C.pack xss) == C.pack (unlines xss)++prop_wordsSBB (String8 xs) =+ C.words (C.pack xs) == map C.pack (words xs)++prop_wordsLC (String8 xs) =+ LC.words (LC.pack xs) == map LC.pack (words xs)++prop_unwordsSBB xss = C.unwords (map C.pack xss) == C.pack (unwords xss)+prop_unwordsSLC xss = LC.unwords (map LC.pack xss) == LC.pack (unwords xss)++prop_splitWithBB_empty f = P.splitWith f mempty == []++prop_splitWithBB f xs = (l1 == l2 || l1 == l2+1) &&+ sum (map P.length splits) == P.length xs - l2+ where splits = P.splitWith f xs+ l1 = length splits+ l2 = P.length (P.filter f xs)++prop_splitBB_empty c = P.split c mempty == []++prop_joinsplitBB c xs = P.intercalate (P.pack [c]) (P.split c xs) == xs++prop_intercalatePL c x y =++ P.intercalate (P.singleton c) (x : y : []) ==+ -- intercalate (singleton c) (s1 : s2 : [])++ P.pack (intercalate [c] [P.unpack x,P.unpack y])++-- prop_linessplitBB xs =+-- (not . C.null) xs ==>+-- C.lines' xs == C.split '\n' xs++-- false:+{-+prop_linessplit2BB xs =+ (not . C.null) xs ==>+ C.lines xs == C.split '\n' xs ++ (if C.last xs == '\n' then [C.empty] else [])+-}++prop_splitsplitWithBB c xs = P.split c xs == P.splitWith (== c) xs++prop_bijectionBB (Char8 c) = (P.w2c . P.c2w) c == id c+prop_bijectionBB' w = (P.c2w . P.w2c) w == id w++prop_packunpackBB s = (P.unpack . P.pack) s == id s+prop_packunpackBB' s = (P.pack . P.unpack) s == id s++prop_eq1BB xs = xs == (P.unpack . P.pack $ xs)+prop_eq2BB xs = xs == (xs :: P.ByteString)+prop_eq3BB xs ys = (xs == ys) == (P.unpack xs == P.unpack ys)++prop_compare1BB xs = (P.pack xs `compare` P.pack xs) == EQ+prop_compare2BB xs c = (P.pack (xs++[c]) `compare` P.pack xs) == GT+prop_compare3BB xs c = (P.pack xs `compare` P.pack (xs++[c])) == LT++prop_compare4BB xs = (not (null xs)) ==> (P.pack xs `compare` P.empty) == GT+prop_compare5BB xs = (not (null xs)) ==> (P.empty `compare` P.pack xs) == LT+prop_compare6BB xs ys= (not (null ys)) ==> (P.pack (xs++ys) `compare` P.pack xs) == GT++prop_compare7BB (Char8 x) (Char8 y) =+ x `compare` y == (C.singleton x `compare` C.singleton y)+prop_compare8BB xs ys = xs `compare` ys == (P.pack xs `compare` P.pack ys)++prop_consBB c xs = P.unpack (P.cons c (P.pack xs)) == (c:xs)+prop_cons1BB (String8 xs)+ = 'X' : xs == C.unpack ('X' `C.cons` (C.pack xs))+prop_cons2BB xs c = c : xs == P.unpack (c `P.cons` (P.pack xs))+prop_cons3BB (Char8 c)+ = C.unpack (C.singleton c) == (c:[])+prop_cons4BB c = (c `P.cons` P.empty) == P.pack (c:[])++prop_snoc1BB xs c = xs ++ [c] == P.unpack ((P.pack xs) `P.snoc` c)++prop_head1BB xs = (not (null xs)) ==> head xs == (P.head . P.pack) xs+prop_head2BB xs = (not (null xs)) ==> head xs == (P.unsafeHead . P.pack) xs+prop_head3BB xs = not (P.null xs) ==> P.head xs == head (P.unpack xs)++prop_tailBB xs = (not (null xs)) ==> tail xs == (P.unpack . P.tail . P.pack) xs+prop_tail1BB xs = (not (null xs)) ==> tail xs == (P.unpack . P.unsafeTail. P.pack) xs++prop_lastBB xs = (not (null xs)) ==> last xs == (P.last . P.pack) xs+prop_last1BB xs = (not (null xs)) ==> last xs == (P.unsafeLast . P.pack) xs++prop_initBB xs =+ (not (null xs)) ==>+ init xs == (P.unpack . P.init . P.pack) xs+prop_init1BB xs =+ (not (null xs)) ==>+ init xs == (P.unpack . P.unsafeInit . P.pack) xs++-- prop_null xs = (null xs) ==> null xs == (nullPS (pack xs))++prop_append1BB xs = (xs ++ xs) == (P.unpack $ P.pack xs `P.append` P.pack xs)+prop_append2BB xs ys = (xs ++ ys) == (P.unpack $ P.pack xs `P.append` P.pack ys)+prop_append3BB xs ys = P.append xs ys == P.pack (P.unpack xs ++ P.unpack ys)++prop_append1BB_monoid xs = (xs ++ xs) == (P.unpack $ P.pack xs `mappend` P.pack xs)+prop_append2BB_monoid xs ys = (xs ++ ys) == (P.unpack $ P.pack xs `mappend` P.pack ys)+prop_append3BB_monoid xs ys = mappend xs ys == P.pack (P.unpack xs ++ P.unpack ys)++prop_append1LL_monoid xs = (xs ++ xs) == (L.unpack $ L.pack xs `mappend` L.pack xs)+prop_append2LL_monoid xs ys = (xs ++ ys) == (L.unpack $ L.pack xs `mappend` L.pack ys)+prop_append3LL_monoid xs ys = mappend xs ys == L.pack (L.unpack xs ++ L.unpack ys)++prop_map1BB f xs = P.map f (P.pack xs) == P.pack (map f xs)+prop_map2BB f g xs = P.map f (P.map g xs) == P.map (f . g) xs+prop_map3BB f xs = map f xs == (P.unpack . P.map f . P.pack) xs+-- prop_mapBB' f xs = P.map' f (P.pack xs) == P.pack (map f xs)++prop_filter1BB (String8 xs) = (filter (=='X') xs) == (C.unpack $ C.filter (=='X') (C.pack xs))+prop_filter2BB p xs = (filter p xs) == (P.unpack $ P.filter p (P.pack xs))++prop_findBB p xs = find p xs == P.find p (P.pack xs)++prop_find_findIndexBB p xs =+ P.find p xs == case P.findIndex p xs of+ Just n -> Just (xs `P.unsafeIndex` n)+ _ -> Nothing++prop_foldl1BB xs a = ((foldl (\x c -> if c == a then x else c:x) [] xs)) ==+ (P.unpack $ P.foldl (\x c -> if c == a then x else c `P.cons` x) P.empty (P.pack xs))+prop_foldl2BB xs = P.foldl (\xs c -> c `P.cons` xs) P.empty (P.pack xs) == P.reverse (P.pack xs)++prop_foldr1BB xs a = ((foldr (\c x -> if c == a then x else c:x) [] xs)) ==+ (P.unpack $ P.foldr (\c x -> if c == a then x else c `P.cons` x)+ P.empty (P.pack xs))++prop_foldr2BB xs = P.foldr (\c xs -> c `P.cons` xs) P.empty (P.pack xs) == (P.pack xs)++prop_foldl1_1BB xs =+ (not . P.null) xs ==>+ P.foldl1 (\x c -> if c > x then c else x) xs ==+ P.foldl (\x c -> if c > x then c else x) 0 xs++prop_foldl1_2BB xs =+ (not . P.null) xs ==>+ P.foldl1 const xs == P.head xs++prop_foldl1_3BB xs =+ (not . P.null) xs ==>+ P.foldl1 (flip const) xs == P.last xs++prop_foldr1_1BB xs =+ (not . P.null) xs ==>+ P.foldr1 (\c x -> if c > x then c else x) xs ==+ P.foldr (\c x -> if c > x then c else x) 0 xs++prop_foldr1_2BB xs =+ (not . P.null) xs ==>+ P.foldr1 (flip const) xs == P.last xs++prop_foldr1_3BB xs =+ (not . P.null) xs ==>+ P.foldr1 const xs == P.head xs++prop_takeWhileBB_ne xs a =+ (takeWhile (/= a) xs) == (P.unpack . (P.takeWhile (/= a)) . P.pack) xs+prop_takeWhileBB_eq xs a =+ (takeWhile (== a) xs) == (P.unpack . (P.takeWhile (== a)) . P.pack) xs++prop_dropWhileBB_ne xs a =+ (dropWhile (/= a) xs) == (P.unpack . (P.dropWhile (/= a)) . P.pack) xs+prop_dropWhileBB_eq xs a =+ (dropWhile (== a) xs) == (P.unpack . (P.dropWhile (== a)) . P.pack) xs++prop_dropWhileCC_isSpace (String8 xs) =+ (dropWhile isSpace xs) ==+ (C.unpack . (C.dropWhile isSpace) . C.pack) xs++prop_takeBB xs = (take 10 xs) == (P.unpack . (P.take 10) . P.pack) xs++prop_dropBB xs = (drop 10 xs) == (P.unpack . (P.drop 10) . P.pack) xs++prop_splitAtBB i xs = -- collect (i >= 0 && i < length xs) $+ splitAt i xs ==+ let (x,y) = P.splitAt i (P.pack xs) in (P.unpack x, P.unpack y)++prop_spanBB xs a = (span (/=a) xs) == (let (x,y) = P.span (/=a) (P.pack xs)+ in (P.unpack x, P.unpack y))++prop_breakBB xs a = (break (/=a) xs) == (let (x,y) = P.break (/=a) (P.pack xs)+ in (P.unpack x, P.unpack y))++prop_reverse1BB xs = (reverse xs) == (P.unpack . P.reverse . P.pack) xs+prop_reverse2BB xs = P.reverse (P.pack xs) == P.pack (reverse xs)+prop_reverse3BB xs = reverse (P.unpack xs) == (P.unpack . P.reverse) xs++prop_elemBB xs a = (a `elem` xs) == (a `P.elem` (P.pack xs))++prop_notElemBB c xs = P.notElem c (P.pack xs) == notElem c xs++-- should try to stress it+prop_concat1BB xs = (concat [xs,xs]) == (P.unpack $ P.concat [P.pack xs, P.pack xs])+prop_concat2BB xs = (concat [xs,[]]) == (P.unpack $ P.concat [P.pack xs, P.pack []])+prop_concatBB xss = P.concat (map P.pack xss) == P.pack (concat xss)++prop_concat1BB_monoid xs = (concat [xs,xs]) == (P.unpack $ mconcat [P.pack xs, P.pack xs])+prop_concat2BB_monoid xs = (concat [xs,[]]) == (P.unpack $ mconcat [P.pack xs, P.pack []])+prop_concatBB_monoid xss = mconcat (map P.pack xss) == P.pack (concat xss)++prop_concat1LL_monoid xs = (concat [xs,xs]) == (L.unpack $ mconcat [L.pack xs, L.pack xs])+prop_concat2LL_monoid xs = (concat [xs,[]]) == (L.unpack $ mconcat [L.pack xs, L.pack []])+prop_concatLL_monoid xss = mconcat (map L.pack xss) == L.pack (concat xss)++prop_concatMapBB xs = C.concatMap C.singleton xs == (C.pack . concatMap (:[]) . C.unpack) xs++prop_anyBB xs a = (any (== a) xs) == (P.any (== a) (P.pack xs))+prop_allBB xs a = (all (== a) xs) == (P.all (== a) (P.pack xs))++prop_linesBB (String8 xs) =+ (lines xs) == ((map C.unpack) . C.lines . C.pack) xs++prop_unlinesBB (String8 xs) =+ (unlines.lines) xs == (C.unpack. C.unlines . C.lines .C.pack) xs+prop_unlinesLC (String8 xs) =+ (unlines.lines) xs == (LC.unpack. LC.unlines . LC.lines .LC.pack) xs++prop_lines_lazy1 =+ head (LC.lines (LC.append (LC.pack "a\nb\n") undefined)) == LC.pack "a"+prop_lines_lazy2 =+ head (tail (LC.lines (LC.append (LC.pack "a\nb\n") undefined))) == LC.pack "b"++prop_wordsBB (String8 xs) =+ (words xs) == ((map C.unpack) . C.words . C.pack) xs+-- prop_wordstokensBB xs = C.words xs == C.tokens isSpace xs++prop_unwordsBB (String8 xs) =+ (C.pack.unwords.words) xs == (C.unwords . C.words .C.pack) xs++prop_groupBB xs = group xs == (map P.unpack . P.group . P.pack) xs++prop_groupByBB xs = groupBy (==) xs == (map P.unpack . P.groupBy (==) . P.pack) xs+prop_groupBy1BB xs = groupBy (/=) xs == (map P.unpack . P.groupBy (/=) . P.pack) xs+prop_groupBy1CC (String8 xs) = groupBy (==) xs == (map C.unpack . C.groupBy (==) . C.pack) xs+prop_groupBy2CC (String8 xs) = groupBy (/=) xs == (map C.unpack . C.groupBy (/=) . C.pack) xs++prop_joinBB (String8 xs) (String8 ys) =+ (concat . (intersperse ys) . lines) xs ==+ (C.unpack $ C.intercalate (C.pack ys) (C.lines (C.pack xs)))++prop_elemIndex1BB (String8 xs) = (elemIndex 'X' xs) == (C.elemIndex 'X' (C.pack xs))+prop_elemIndex2BB (String8 xs) (Char8 c) = (elemIndex c xs) == (C.elemIndex c (C.pack xs))++-- prop_lineIndices1BB xs = C.elemIndices '\n' xs == C.lineIndices xs++prop_countBB c xs = length (P.elemIndices c xs) == P.count c xs++prop_elemIndexEnd1BB c xs =+ P.elemIndexEnd c (P.pack xs) ==+ case P.elemIndex c (P.pack (reverse xs)) of+ Nothing -> Nothing+ Just i -> Just (length xs - 1 - i)++prop_elemIndexEnd1CC (Char8 c) (String8 xs) =+ C.elemIndexEnd c (C.pack xs) ==+ case C.elemIndex c (C.pack (reverse xs)) of+ Nothing -> Nothing+ Just i -> Just (length xs - 1 - i)++prop_elemIndexEnd1LL c xs =+ L.elemIndexEnd c (L.pack xs) ==+ case L.elemIndex c (L.pack (reverse xs)) of+ Nothing -> Nothing+ Just i -> Just (fromIntegral (length xs) - 1 - i)++prop_elemIndexEnd1DD (Char8 c) (String8 xs) =+ D.elemIndexEnd c (D.pack xs) ==+ case D.elemIndex c (D.pack (reverse xs)) of+ Nothing -> Nothing+ Just i -> Just (fromIntegral (length xs) - 1 - i)++prop_elemIndicesBB xs c = elemIndices c xs == P.elemIndices c (P.pack xs)++prop_findIndexBB xs a = (findIndex (==a) xs) == (P.findIndex (==a) (P.pack xs))++prop_findIndexEndBB xs a = (findIndexEnd (==a) xs) == (P.findIndexEnd (==a) (P.pack xs))++prop_findIndexEndLL xs a = (findIndexEnd (==a) xs) == fmap fromIntegral (L.findIndexEnd (==a) (L.pack xs))++prop_findIndexEndDD (String8 xs) (Char8 a) = (findIndexEnd (==a) xs) == fmap fromIntegral (D.findIndexEnd (==a) (D.pack xs))++prop_findIndiciesBB xs c = (findIndices (==c) xs) == (P.findIndices (==c) (P.pack xs))++-- example properties from QuickCheck.Batch+prop_sort1BB xs = sort xs == (P.unpack . P.sort . P.pack) xs+prop_sort2BB xs = (not (null xs)) ==> (P.head . P.sort . P.pack $ xs) == minimum xs+prop_sort3BB xs = (not (null xs)) ==> (P.last . P.sort . P.pack $ xs) == maximum xs+prop_sort4BB xs ys =+ (not (null xs)) ==>+ (not (null ys)) ==>+ (P.head . P.sort) (P.append (P.pack xs) (P.pack ys)) == min (minimum xs) (minimum ys)+prop_sort5BB xs ys =+ (not (null xs)) ==>+ (not (null ys)) ==>+ (P.last . P.sort) (P.append (P.pack xs) (P.pack ys)) == max (maximum xs) (maximum ys)++prop_intersperseBB c xs = (intersperse c xs) == (P.unpack $ P.intersperse c (P.pack xs))++-- prop_transposeBB xs = (transpose xs) == ((map P.unpack) . P.transpose . (map P.pack)) xs++prop_maximumBB xs = (not (null xs)) ==> (maximum xs) == (P.maximum ( P.pack xs ))+prop_minimumBB xs = (not (null xs)) ==> (minimum xs) == (P.minimum ( P.pack xs ))++prop_strip = C.strip `eq1` (C.dropSpace . C.reverse . C.dropSpace . C.reverse)++-- prop_dropSpaceBB xs = dropWhile isSpace xs == C.unpack (C.dropSpace (C.pack xs))+-- prop_dropSpaceEndBB xs = (C.reverse . (C.dropWhile isSpace) . C.reverse) (C.pack xs) ==+-- (C.dropSpaceEnd (C.pack xs))++-- prop_breakSpaceBB xs =+-- (let (x,y) = C.breakSpace (C.pack xs)+-- in (C.unpack x, C.unpack y)) == (break isSpace xs)++prop_spanEndBB xs =+ (C.spanEnd (not . isSpace) (C.pack xs)) ==+ (let (x,y) = C.span (not.isSpace) (C.reverse (C.pack xs)) in (C.reverse y,C.reverse x))++prop_breakEndBB p xs = P.breakEnd (not.p) xs == P.spanEnd p xs+prop_breakEndCC p xs = C.breakEnd (not.p) xs == C.spanEnd p xs++{-+prop_breakCharBB c xs =+ (break (==c) xs) ==+ (let (x,y) = C.breakChar c (C.pack xs) in (C.unpack x, C.unpack y))++prop_spanCharBB c xs =+ (break (/=c) xs) ==+ (let (x,y) = C.spanChar c (C.pack xs) in (C.unpack x, C.unpack y))++prop_spanChar_1BB c xs =+ (C.span (==c) xs) == C.spanChar c xs++prop_wordsBB' xs =+ (C.unpack . C.unwords . C.words' . C.pack) xs ==+ (map (\c -> if isSpace c then ' ' else c) xs)++-- prop_linesBB' xs = (C.unpack . C.unlines' . C.lines' . C.pack) xs == (xs)+-}++prop_unfoldrBB c =+ forAll arbitrarySizedIntegral $ \n ->+ (fst $ C.unfoldrN n fn c) == (C.pack $ take n $ unfoldr fn c)+ where+ fn x = Just (x, if x == maxBound then x else succ x)++prop_prefixBB xs ys = isPrefixOf xs ys == (P.pack xs `P.isPrefixOf` P.pack ys)+prop_prefixLL xs ys = isPrefixOf xs ys == (L.pack xs `L.isPrefixOf` L.pack ys)+prop_suffixBB xs ys = isSuffixOf xs ys == (P.pack xs `P.isSuffixOf` P.pack ys)+prop_suffixLL xs ys = isSuffixOf xs ys == (L.pack xs `L.isSuffixOf` L.pack ys)++prop_stripPrefixBB xs ys = (P.pack <$> stripPrefix xs ys) == (P.pack xs `P.stripPrefix` P.pack ys)+prop_stripPrefixLL xs ys = (L.pack <$> stripPrefix xs ys) == (L.pack xs `L.stripPrefix` L.pack ys)+prop_stripSuffixBB xs ys = (P.pack <$> stripSuffix xs ys) == (P.pack xs `P.stripSuffix` P.pack ys)+prop_stripSuffixLL xs ys = (L.pack <$> stripSuffix xs ys) == (L.pack xs `L.stripSuffix` L.pack ys)++prop_copyBB xs = let p = P.pack xs in P.copy p == p+prop_copyLL xs = let p = L.pack xs in L.copy p == p++prop_initsBB xs = inits xs == map P.unpack (P.inits (P.pack xs))++prop_tailsBB xs = tails xs == map P.unpack (P.tails (P.pack xs))++-- correspondance between break and breakSubstring+prop_breakSubstringBB c l+ = P.break (== c) l == P.breakSubstring (P.singleton c) l++prop_breakSubstring_isInfixOf s l+ = P.isInfixOf s l == if P.null s then True+ else case P.breakSubstring s l of+ (x,y) | P.null y -> False+ | otherwise -> True++prop_replicate1BB c = forAll arbitrarySizedIntegral $ \n ->+ P.unpack (P.replicate n c) == replicate n c+prop_replicate2BB c = forAll arbitrarySizedIntegral $ \n ->+ P.replicate n c == fst (P.unfoldrN n (\u -> Just (u,u)) c)++prop_replicate3BB c = P.unpack (P.replicate 0 c) == replicate 0 c++prop_readintBB n = (fst . fromJust . C.readInt . C.pack . show) n == (n :: Int)+prop_readintLL n = (fst . fromJust . D.readInt . D.pack . show) n == (n :: Int)++prop_readBB x = (read . show) x == (x :: P.ByteString)+prop_readLL x = (read . show) x == (x :: L.ByteString)++prop_readint2BB (String8 s) =+ let s' = filter (\c -> c `notElem` ['0'..'9']) s+ in C.readInt (C.pack s') == Nothing++prop_readintegerBB n = (fst . fromJust . C.readInteger . C.pack . show) n == (n :: Integer)+prop_readintegerLL n = (fst . fromJust . D.readInteger . D.pack . show) n == (n :: Integer)++prop_readinteger2BB (String8 s) =+ let s' = filter (\c -> c `notElem` ['0'..'9']) s+ in C.readInteger (C.pack s') == Nothing+++-- Ensure that readInt and readInteger over lazy ByteStrings are not+-- excessively strict.+prop_readIntSafe = (fst . fromJust . D.readInt) (Chunk (C.pack "1z") Empty) == 1+prop_readIntUnsafe = (fst . fromJust . D.readInt) (Chunk (C.pack "2z") undefined) == 2+prop_readIntegerSafe = (fst . fromJust . D.readInteger) (Chunk (C.pack "1z") Empty) == 1+prop_readIntegerUnsafe = (fst . fromJust . D.readInteger) (Chunk (C.pack "2z") undefined) == 2++-- prop_filterChar1BB c xs = (filter (==c) xs) == ((C.unpack . C.filterChar c . C.pack) xs)+-- prop_filterChar2BB c xs = (C.filter (==c) (C.pack xs)) == (C.filterChar c (C.pack xs))+-- prop_filterChar3BB c xs = C.filterChar c xs == C.replicate (C.count c xs) c++-- prop_filterNotChar1BB c xs = (filter (/=c) xs) == ((C.unpack . C.filterNotChar c . C.pack) xs)+-- prop_filterNotChar2BB c xs = (C.filter (/=c) (C.pack xs)) == (C.filterNotChar c (C.pack xs))++-- prop_joinjoinpathBB xs ys c = C.joinWithChar c xs ys == C.join (C.singleton c) [xs,ys]++prop_zipBB xs ys = zip xs ys == P.zip (P.pack xs) (P.pack ys)+prop_zipLC (String8 xs) (String8 ys)+ = zip xs ys == LC.zip (LC.pack xs) (LC.pack ys)+prop_zip1BB xs ys = P.zip xs ys == zip (P.unpack xs) (P.unpack ys)++prop_zipWithBB xs ys = P.zipWith (,) xs ys == P.zip xs ys+prop_zipWithCC xs ys = C.zipWith (,) xs ys == C.zip xs ys+prop_zipWithLC xs ys = LC.zipWith (,) xs ys == LC.zip xs ys++prop_packZipWithBB f xs ys = P.pack (P.zipWith f xs ys) == P.packZipWith f xs ys+prop_packZipWithLL f xs ys = L.pack (L.zipWith f xs ys) == L.packZipWith f xs ys+prop_packZipWithBC f xs ys = C.pack (C.zipWith f xs ys) == C.packZipWith f xs ys+prop_packZipWithLC f xs ys = LC.pack (LC.zipWith f xs ys) == LC.packZipWith f xs ys+++prop_unzipBB x = let (xs,ys) = unzip x in (P.pack xs, P.pack ys) == P.unzip x++#if MIN_VERSION_base(4,9,0)+prop_stimesBB :: NonNegative Int -> P.ByteString -> Bool+prop_stimesBB (NonNegative i) bs = stimes i bs == mtimesDefault i bs++prop_stimesLL :: NonNegative Int -> L.ByteString -> Bool+prop_stimesLL (NonNegative i) bs = stimes i bs == mtimesDefault i bs+#endif++-- prop_zipwith_spec f p q =+-- P.pack (P.zipWith f p q) == P.zipWith' f p q+-- where _ = f :: Word8 -> Word8 -> Word8++-- prop_join_spec c s1 s2 =+-- P.join (P.singleton c) (s1 : s2 : []) == P.joinWithByte c s1 s2++------------------------------------------------------------------------++-- Test IsString, Show, Read, pack, unpack+prop_isstring :: String8 -> Bool+prop_isstring_lc :: String8 -> Bool++prop_isstring (String8 x) = C.unpack (fromString x :: C.ByteString) == x+prop_isstring_lc (String8 x) = LC.unpack (fromString x :: LC.ByteString) == x++prop_showP1 x = show x == show (C.unpack x)+prop_showL1 x = show x == show (LC.unpack x)++prop_readP1 x = read (show x) == (x :: P.ByteString)+prop_readP2 x = read (show x) == C.pack (x :: String)++prop_readL1 x = read (show x) == (x :: L.ByteString)+prop_readL2 x = read (show x) == LC.pack (x :: String)++prop_packunpack_s x = (P.unpack . P.pack) x == x+prop_unpackpack_s x = (P.pack . P.unpack) x == x++prop_packunpack_c (String8 x) = (C.unpack . C.pack) x == x+prop_unpackpack_c x = (C.pack . C.unpack) x == x++prop_packunpack_l x = (L.unpack . L.pack) x == x+prop_unpackpack_l x = (L.pack . L.unpack) x == x++prop_packunpack_lc (String8 x) = (LC.unpack . LC.pack) x == x+prop_unpackpack_lc x = (LC.pack . LC.unpack) x == x++prop_toFromChunks x = (L.fromChunks . L.toChunks) x == x+prop_fromToChunks x = (L.toChunks . L.fromChunks) x == filter (not . P.null) x++prop_toFromStrict x = (L.fromStrict . L.toStrict) x == x+prop_fromToStrict x = (L.toStrict . L.fromStrict) x == x++prop_packUptoLenBytes cs =+ forAll (choose (0, length cs + 1)) $ \n ->+ let (bs, cs') = P.packUptoLenBytes n cs+ in P.length bs == min n (length cs)+ && take n cs == P.unpack bs+ && P.pack (take n cs) == bs+ && drop n cs == cs'++prop_packUptoLenChars (String8 cs) =+ forAll (choose (0, length cs + 1)) $ \n ->+ let (bs, cs') = P.packUptoLenChars n cs+ in P.length bs == min n (length cs)+ && take n cs == C.unpack bs+ && C.pack (take n cs) == bs+ && drop n cs == cs'++prop_unpack_s cs =+ forAll (choose (0, length cs)) $ \n ->+ P.unpack (P.drop n $ P.pack cs) == drop n cs+prop_unpack_c (String8 cs) =+ forAll (choose (0, length cs)) $ \n ->+ C.unpack (C.drop n $ C.pack cs) == drop n cs++prop_unpack_l cs =+ forAll (choose (0, length cs)) $ \n ->+ L.unpack (L.drop (fromIntegral n) $ L.pack cs) == drop n cs+prop_unpack_lc (String8 cs) =+ forAll (choose (0, length cs)) $ \n ->+ LC.unpack (L.drop (fromIntegral n) $ LC.pack cs) == drop n cs++prop_unpackBytes cs =+ forAll (choose (0, length cs)) $ \n ->+ P.unpackBytes (P.drop n $ P.pack cs) == drop n cs+prop_unpackChars (String8 cs) =+ forAll (choose (0, length cs)) $ \n ->+ P.unpackChars (P.drop n $ C.pack cs) == drop n cs++prop_unpackBytes_l =+ forAll (sized $ \n -> resize (n * 10) arbitrary) $ \cs ->+ forAll (choose (0, length cs)) $ \n ->+ L.unpackBytes (L.drop (fromIntegral n) $ L.pack cs) == drop n cs+prop_unpackChars_l =+ forAll (sized $ \n -> resize (n * 10) arbitrary) $ \(String8 cs) ->+ forAll (choose (0, length cs)) $ \n ->+ L.unpackChars (L.drop (fromIntegral n) $ LC.pack cs) == drop n cs++prop_unpackAppendBytesLazy cs' =+ forAll (sized $ \n -> resize (n * 10) arbitrary) $ \cs ->+ forAll (choose (0, 2)) $ \n ->+ P.unpackAppendBytesLazy (P.drop n $ P.pack cs) cs' == drop n cs ++ cs'+prop_unpackAppendCharsLazy (String8 cs') =+ forAll (sized $ \n -> resize (n * 10) arbitrary) $ \(String8 cs) ->+ forAll (choose (0, 2)) $ \n ->+ P.unpackAppendCharsLazy (P.drop n $ C.pack cs) cs' == drop n cs ++ cs'++prop_unpackAppendBytesStrict cs cs' =+ forAll (choose (0, length cs)) $ \n ->+ P.unpackAppendBytesStrict (P.drop n $ P.pack cs) cs' == drop n cs ++ cs'++prop_unpackAppendCharsStrict (String8 cs) (String8 cs') =+ forAll (choose (0, length cs)) $ \n ->+ P.unpackAppendCharsStrict (P.drop n $ C.pack cs) cs' == drop n cs ++ cs'++------------------------------------------------------------------------+-- Unsafe functions++-- Test unsafePackAddress+prop_unsafePackAddress (CByteString x) = ioProperty $ do+ let (p,_,_) = P.toForeignPtr (x `P.snoc` 0)+ y <- withForeignPtr p $ \(Ptr addr) ->+ P.unsafePackAddress addr+ return (y == x)++-- Test unsafePackAddressLen+prop_unsafePackAddressLen x = ioProperty $ do+ let i = P.length x+ (p,_,_) = P.toForeignPtr (x `P.snoc` 0)+ y <- withForeignPtr p $ \(Ptr addr) ->+ P.unsafePackAddressLen i addr+ return (y == x)++prop_unsafeUseAsCString x = ioProperty $ do+ let n = P.length x+ y <- P.unsafeUseAsCString x $ \cstr ->+ sequence [ do a <- peekElemOff cstr i+ let b = x `P.index` i+ return (a == fromIntegral b)+ | i <- [0.. n-1] ]+ return (and y)++prop_unsafeUseAsCStringLen x = ioProperty $ do+ let n = P.length x+ y <- P.unsafeUseAsCStringLen x $ \(cstr,_) ->+ sequence [ do a <- peekElemOff cstr i+ let b = x `P.index` i+ return (a == fromIntegral b)+ | i <- [0.. n-1] ]+ return (and y)++prop_internal_invariant x = L.invariant x++prop_useAsCString x = ioProperty $ do+ let n = P.length x+ y <- P.useAsCString x $ \cstr ->+ sequence [ do a <- peekElemOff cstr i+ let b = x `P.index` i+ return (a == fromIntegral b)+ | i <- [0.. n-1] ]+ return (and y)++prop_packCString (CByteString x) = ioProperty $ do+ y <- P.useAsCString x $ P.unsafePackCString+ return (y == x)++prop_packCString_safe (CByteString x) = ioProperty $ do+ y <- P.useAsCString x $ P.packCString+ return (y == x)++prop_packCStringLen x = ioProperty $ do+ y <- P.useAsCStringLen x $ P.unsafePackCStringLen+ return (y == x && P.length y == P.length x)++prop_packCStringLen_safe x = ioProperty $ do+ y <- P.useAsCStringLen x $ P.packCStringLen+ return (y == x && P.length y == P.length x)++prop_packMallocCString (CByteString x) = ioProperty $ do++ let (fp,_,_) = P.toForeignPtr x+ ptr <- mallocArray0 (P.length x) :: IO (Ptr Word8)+ forM_ [0 .. P.length x] $ \n -> pokeElemOff ptr n 0+ withForeignPtr fp $ \qtr -> copyArray ptr qtr (P.length x)+ y <- P.unsafePackMallocCString (castPtr ptr)++ let !z = y == x+ free ptr `seq` return z++prop_unsafeFinalize x =+ P.length x > 0 ==>+ ioProperty $ do+ x <- P.unsafeFinalize x+ return (x == ())++prop_packCStringFinaliser x = ioProperty $ do+ y <- P.useAsCString x $ \cstr -> P.unsafePackCStringFinalizer (castPtr cstr) (P.length x) (return ())+ return (y == x)++prop_fromForeignPtr x = (let (a,b,c) = (P.toForeignPtr x)+ in P.fromForeignPtr a b c) == x++------------------------------------------------------------------------+-- IO++prop_read_write_file_P x = ioProperty $ do+ (fn, h) <- openTempFile "." "prop-compiled.tmp"+ hClose h+ P.writeFile fn x+ y <- P.readFile fn+ removeFile fn+ return (x == y)++prop_read_write_file_C x = ioProperty $ do+ (fn, h) <- openTempFile "." "prop-compiled.tmp"+ hClose h+ C.writeFile fn x+ y <- C.readFile fn+ removeFile fn+ return (x == y)++prop_read_write_file_L x = ioProperty $ do+ (fn, h) <- openTempFile "." "prop-compiled.tmp"+ hClose h+ L.writeFile fn x+ y <- L.readFile fn+ L.length y `seq` removeFile fn+ return (x == y)++prop_read_write_file_D x = ioProperty $ do+ (fn, h) <- openTempFile "." "prop-compiled.tmp"+ hClose h+ D.writeFile fn x+ y <- D.readFile fn+ D.length y `seq` removeFile fn+ return (x == y)++------------------------------------------------------------------------++prop_append_file_P x y = ioProperty $ do+ (fn, h) <- openTempFile "." "prop-compiled.tmp"+ hClose h+ P.writeFile fn x+ P.appendFile fn y+ z <- P.readFile fn+ removeFile fn+ return (z == x `P.append` y)++prop_append_file_C x y = ioProperty $ do+ (fn, h) <- openTempFile "." "prop-compiled.tmp"+ hClose h+ C.writeFile fn x+ C.appendFile fn y+ z <- C.readFile fn+ removeFile fn+ return (z == x `C.append` y)++prop_append_file_L x y = ioProperty $ do+ (fn, h) <- openTempFile "." "prop-compiled.tmp"+ hClose h+ L.writeFile fn x+ L.appendFile fn y+ z <- L.readFile fn+ L.length y `seq` removeFile fn+ return (z == x `L.append` y)++prop_append_file_D x y = ioProperty $ do+ (fn, h) <- openTempFile "." "prop-compiled.tmp"+ hClose h+ D.writeFile fn x+ D.appendFile fn y+ z <- D.readFile fn+ D.length y `seq` removeFile fn+ return (z == x `D.append` y)++prop_packAddress = C.pack "this is a test"+ ==+ C.pack "this is a test"++prop_isSpaceWord8 w = isSpace c == P.isSpaceChar8 c+ where c = chr (fromIntegral (w :: Word8))+++------------------------------------------------------------------------+-- ByteString.Short+--++prop_short_pack_unpack xs =+ (Short.unpack . Short.pack) xs == xs+prop_short_toShort_fromShort bs =+ (Short.fromShort . Short.toShort) bs == bs++prop_short_toShort_unpack bs =+ (Short.unpack . Short.toShort) bs == P.unpack bs+prop_short_pack_fromShort xs =+ (Short.fromShort . Short.pack) xs == P.pack xs++prop_short_empty =+ Short.empty == Short.toShort P.empty+ && Short.empty == Short.pack []+ && Short.null (Short.toShort P.empty)+ && Short.null (Short.pack [])+ && Short.null Short.empty++prop_short_null_toShort bs =+ P.null bs == Short.null (Short.toShort bs)+prop_short_null_pack xs =+ null xs == Short.null (Short.pack xs)++prop_short_length_toShort bs =+ P.length bs == Short.length (Short.toShort bs)+prop_short_length_pack xs =+ length xs == Short.length (Short.pack xs)++prop_short_index_pack xs =+ all (\i -> Short.pack xs `Short.index` i == xs !! i)+ [0 .. length xs - 1]+prop_short_index_toShort bs =+ all (\i -> Short.toShort bs `Short.index` i == bs `P.index` i)+ [0 .. P.length bs - 1]++prop_short_eq xs ys =+ (xs == ys) == (Short.pack xs == Short.pack ys)+prop_short_ord xs ys =+ (xs `compare` ys) == (Short.pack xs `compare` Short.pack ys)++prop_short_mappend_empty_empty =+ Short.empty `mappend` Short.empty == Short.empty+prop_short_mappend_empty xs =+ Short.empty `mappend` Short.pack xs == Short.pack xs+ && Short.pack xs `mappend` Short.empty == Short.pack xs+prop_short_mappend xs ys =+ (xs `mappend` ys) == Short.unpack (Short.pack xs `mappend` Short.pack ys)+prop_short_mconcat xss =+ mconcat xss == Short.unpack (mconcat (map Short.pack xss))++prop_short_fromString s =+ fromString s == Short.fromShort (fromString s)++prop_short_show xs =+ show (Short.pack xs) == show (map P.w2c xs)+prop_short_show' xs =+ show (Short.pack xs) == show (P.pack xs)++prop_short_read xs =+ read (show (Short.pack xs)) == Short.pack xs++prop_short_pinned :: NonNegative Int -> Property+prop_short_pinned (NonNegative (I# len#)) = runST $ ST $ \s ->+ case newPinnedByteArray# len# s of+ (# s', mba# #) -> case unsafeFreezeByteArray# mba# s' of+ (# s'', ba# #) -> let sbs = Short.SBS ba# in+ (# s'', sbs === Short.toShort (Short.fromShort sbs) #)++stripSuffix :: [W] -> [W] -> Maybe [W]+stripSuffix xs ys = reverse <$> stripPrefix (reverse xs) (reverse ys)++short_tests =+ [ testProperty "pack/unpack" prop_short_pack_unpack+ , testProperty "toShort/fromShort" prop_short_toShort_fromShort+ , testProperty "toShort/unpack" prop_short_toShort_unpack+ , testProperty "pack/fromShort" prop_short_pack_fromShort+ , testProperty "empty" prop_short_empty+ , testProperty "null/toShort" prop_short_null_toShort+ , testProperty "null/pack" prop_short_null_pack+ , testProperty "length/toShort" prop_short_length_toShort+ , testProperty "length/pack" prop_short_length_pack+ , testProperty "index/pack" prop_short_index_pack+ , testProperty "index/toShort" prop_short_index_toShort+ , testProperty "Eq" prop_short_eq+ , testProperty "Ord" prop_short_ord+ , testProperty "mappend/empty/empty" prop_short_mappend_empty_empty+ , testProperty "mappend/empty" prop_short_mappend_empty+ , testProperty "mappend" prop_short_mappend+ , testProperty "mconcat" prop_short_mconcat+ , testProperty "fromString" prop_short_fromString+ , testProperty "show" prop_short_show+ , testProperty "show'" prop_short_show'+ , testProperty "read" prop_short_read+ , testProperty "pinned" prop_short_pinned+ ]++------------------------------------------------------------------------+-- The entry point++main :: IO ()+main = defaultMain $ testGroup "All" tests++--+-- And now a list of all the properties to test.+--++tests = misc_tests+ ++ bl_tests+ ++ cc_tests+ ++ bp_tests+ ++ pl_tests+ ++ bb_tests+ ++ ll_tests+ ++ io_tests+ ++ short_tests+ ++ rules++--+-- 'morally sound' IO+--+io_tests =+ [ testProperty "readFile.writeFile" prop_read_write_file_P+ , testProperty "readFile.writeFile" prop_read_write_file_C+ , testProperty "readFile.writeFile" prop_read_write_file_L+ , testProperty "readFile.writeFile" prop_read_write_file_D++ , testProperty "appendFile " prop_append_file_P+ , testProperty "appendFile " prop_append_file_C+ , testProperty "appendFile " prop_append_file_L+ , testProperty "appendFile " prop_append_file_D++ , testProperty "packAddress " prop_packAddress++ ]++misc_tests =+ [ testProperty "packunpack (bytes)" prop_packunpack_s+ , testProperty "unpackpack (bytes)" prop_unpackpack_s+ , testProperty "packunpack (chars)" prop_packunpack_c+ , testProperty "unpackpack (chars)" prop_unpackpack_c+ , testProperty "packunpack (lazy bytes)" prop_packunpack_l+ , testProperty "unpackpack (lazy bytes)" prop_unpackpack_l+ , testProperty "packunpack (lazy chars)" prop_packunpack_lc+ , testProperty "unpackpack (lazy chars)" prop_unpackpack_lc+ , testProperty "unpack (bytes)" prop_unpack_s+ , testProperty "unpack (chars)" prop_unpack_c+ , testProperty "unpack (lazy bytes)" prop_unpack_l+ , testProperty "unpack (lazy chars)" prop_unpack_lc+ , testProperty "packUptoLenBytes" prop_packUptoLenBytes+ , testProperty "packUptoLenChars" prop_packUptoLenChars+ , testProperty "unpackBytes" prop_unpackBytes+ , testProperty "unpackChars" prop_unpackChars+ , testProperty "unpackBytes" prop_unpackBytes_l+ , testProperty "unpackChars" prop_unpackChars_l+ , testProperty "unpackAppendBytesLazy" prop_unpackAppendBytesLazy+ , testProperty "unpackAppendCharsLazy" prop_unpackAppendCharsLazy+ , testProperty "unpackAppendBytesStrict"prop_unpackAppendBytesStrict+ , testProperty "unpackAppendCharsStrict"prop_unpackAppendCharsStrict+ , testProperty "toFromChunks" prop_toFromChunks+ , testProperty "fromToChunks" prop_fromToChunks+ , testProperty "toFromStrict" prop_toFromStrict+ , testProperty "fromToStrict" prop_fromToStrict++ , testProperty "invariant" prop_invariant+ , testProperty "unsafe pack address" prop_unsafePackAddress+ , testProperty "unsafe pack address len"prop_unsafePackAddressLen+ , testProperty "unsafeUseAsCString" prop_unsafeUseAsCString+ , testProperty "unsafeUseAsCStringLen" prop_unsafeUseAsCStringLen+ , testProperty "useAsCString" prop_useAsCString+ , testProperty "packCString" prop_packCString+ , testProperty "packCString safe" prop_packCString_safe+ , testProperty "packCStringLen" prop_packCStringLen+ , testProperty "packCStringLen safe" prop_packCStringLen_safe+ , testProperty "packCStringFinaliser" prop_packCStringFinaliser+ , testProperty "packMallocString" prop_packMallocCString+ , testProperty "unsafeFinalise" prop_unsafeFinalize+ , testProperty "invariant" prop_internal_invariant+ , testProperty "show 1" prop_showP1+ , testProperty "show 2" prop_showL1+ , testProperty "read 1" prop_readP1+ , testProperty "read 2" prop_readP2+ , testProperty "read 3" prop_readL1+ , testProperty "read 4" prop_readL2+ , testProperty "fromForeignPtr" prop_fromForeignPtr+ ]++------------------------------------------------------------------------+-- ByteString.Lazy <=> List++bl_tests =+ [ testProperty "all" prop_allBL+ , testProperty "any" prop_anyBL+ , testProperty "append" prop_appendBL+ , testProperty "compare" prop_compareBL+ , testProperty "concat" prop_concatBL+ , testProperty "cons" prop_consBL+ , testProperty "eq" prop_eqBL+ , testProperty "filter" prop_filterBL+ , testProperty "find" prop_findBL+ , testProperty "findIndex" prop_findIndexBL+ , testProperty "findIndexEnd"prop_findIndexEndBL+ , testProperty "findIndices" prop_findIndicesBL+ , testProperty "foldl" prop_foldlBL+ , testProperty "foldl'" prop_foldlBL'+ , testProperty "foldl1" prop_foldl1BL+ , testProperty "foldl1'" prop_foldl1BL'+ , testProperty "foldr" prop_foldrBL+ , testProperty "foldr1" prop_foldr1BL+ , testProperty "mapAccumL" prop_mapAccumLBL+ , testProperty "mapAccumR" prop_mapAccumRBL+ , testProperty "mapAccumR" prop_mapAccumRDL+ , testProperty "mapAccumR" prop_mapAccumRCC+ , testProperty "unfoldr" prop_unfoldrBL+ , testProperty "unfoldr" prop_unfoldrLC+ , testProperty "unfoldr" prop_cycleLC+ , testProperty "iterate" prop_iterateLC+ , testProperty "iterate" prop_iterateLC_2+ , testProperty "iterate" prop_iterateL+ , testProperty "repeat" prop_repeatLC+ , testProperty "repeat" prop_repeatL+ , testProperty "head" prop_headBL+ , testProperty "init" prop_initBL+ , testProperty "isPrefixOf" prop_isPrefixOfBL+ , testProperty "isSuffixOf" prop_isSuffixOfBL+ , testProperty "stripPrefix" prop_stripPrefixBL+ , testProperty "stripSuffix" prop_stripSuffixBL+ , testProperty "last" prop_lastBL+ , testProperty "length" prop_lengthBL+ , testProperty "map" prop_mapBL+ , testProperty "maximum" prop_maximumBL+ , testProperty "minimum" prop_minimumBL+ , testProperty "null" prop_nullBL+ , testProperty "reverse" prop_reverseBL+ , testProperty "snoc" prop_snocBL+ , testProperty "tail" prop_tailBL+ , testProperty "transpose" prop_transposeBL+ , testProperty "replicate" prop_replicateBL+ , testProperty "take" prop_takeBL+ , testProperty "drop" prop_dropBL+ , testProperty "splitAt" prop_splitAtBL+ , testProperty "takeWhile" prop_takeWhileBL+ , testProperty "dropWhile" prop_dropWhileBL+ , testProperty "break" prop_breakBL+ , testProperty "span" prop_spanBL+ , testProperty "group" prop_groupBL+ , testProperty "groupBy" prop_groupByBL+ , testProperty "inits" prop_initsBL+ , testProperty "tails" prop_tailsBL+ , testProperty "elem" prop_elemBL+ , testProperty "notElem" prop_notElemBL+ , testProperty "lines" prop_linesBL+ , testProperty "elemIndex" prop_elemIndexBL+ , testProperty "elemIndexEnd"prop_elemIndexEndBL+ , testProperty "elemIndices" prop_elemIndicesBL+ , testProperty "concatMap" prop_concatMapBL+ , testProperty "zipWith/packZipWithLazy" prop_packZipWithBL+ ]++------------------------------------------------------------------------+-- ByteString.Lazy <=> ByteString++cc_tests =+ [ testProperty "prop_concatCC" prop_concatCC+ , testProperty "prop_nullCC" prop_nullCC+ , testProperty "prop_reverseCC" prop_reverseCC+ , testProperty "prop_transposeCC" prop_transposeCC+ , testProperty "prop_groupCC" prop_groupCC+ , testProperty "prop_groupByCC" prop_groupByCC+ , testProperty "prop_initsCC" prop_initsCC+ , testProperty "prop_tailsCC" prop_tailsCC+ , testProperty "prop_allCC" prop_allCC+ , testProperty "prop_anyCC" prop_anyCC+ , testProperty "prop_appendCC" prop_appendCC+ , testProperty "prop_breakCC" prop_breakCC+ , testProperty "prop_concatMapCC" prop_concatMapCC+ , testProperty "prop_consCC" prop_consCC+ , testProperty "prop_consCC'" prop_consCC'+ , testProperty "prop_unconsCC" prop_unconsCC+ , testProperty "prop_unsnocCC" prop_unsnocCC+ , testProperty "prop_countCC" prop_countCC+ , testProperty "prop_dropCC" prop_dropCC+ , testProperty "prop_dropWhileCC" prop_dropWhileCC+ , testProperty "prop_filterCC" prop_filterCC+ , testProperty "prop_findCC" prop_findCC+ , testProperty "prop_findIndexCC" prop_findIndexCC+ , testProperty "prop_findIndexEndCC" prop_findIndexEndCC+ , testProperty "prop_findIndicesCC" prop_findIndicesCC+ , testProperty "prop_isPrefixCC" prop_isPrefixOfCC+ , testProperty "prop_isSuffixCC" prop_isSuffixOfCC+ , testProperty "prop_stripPrefixCC" prop_stripPrefixCC+ , testProperty "prop_stripSuffixCC" prop_stripSuffixCC+ , testProperty "prop_mapCC" prop_mapCC+ , testProperty "prop_replicateCC" prop_replicateCC+ , testProperty "prop_snocCC" prop_snocCC+ , testProperty "prop_spanCC" prop_spanCC+ , testProperty "prop_splitCC" prop_splitCC+ , testProperty "prop_splitAtCC" prop_splitAtCC+ , testProperty "prop_takeCC" prop_takeCC+ , testProperty "prop_takeWhileCC" prop_takeWhileCC+ , testProperty "prop_elemCC" prop_elemCC+ , testProperty "prop_notElemCC" prop_notElemCC+ , testProperty "prop_elemIndexCC" prop_elemIndexCC+ , testProperty "prop_elemIndicesCC" prop_elemIndicesCC+ , testProperty "prop_lengthCC" prop_lengthCC+ , testProperty "prop_headCC" prop_headCC+ , testProperty "prop_initCC" prop_initCC+ , testProperty "prop_lastCC" prop_lastCC+ , testProperty "prop_maximumCC" prop_maximumCC+ , testProperty "prop_minimumCC" prop_minimumCC+ , testProperty "prop_tailCC" prop_tailCC+ , testProperty "prop_foldl1CC" prop_foldl1CC+ , testProperty "prop_foldl1CC'" prop_foldl1CC'+ , testProperty "prop_foldr1CC" prop_foldr1CC+ , testProperty "prop_foldr1CC'" prop_foldr1CC'+ , testProperty "prop_scanlCC" prop_scanlCC+ , testProperty "prop_intersperseCC" prop_intersperseCC++ , testProperty "prop_foldlCC" prop_foldlCC+ , testProperty "prop_foldlCC'" prop_foldlCC'+ , testProperty "prop_foldrCC" prop_foldrCC+ , testProperty "prop_foldrCC'" prop_foldrCC'+ , testProperty "prop_mapAccumLCC" prop_mapAccumLCC+-- , testProperty "prop_mapIndexedCC" prop_mapIndexedCC+-- , testProperty "prop_mapIndexedPL" prop_mapIndexedPL+ ]++bp_tests =+ [ testProperty "all" prop_allBP+ , testProperty "any" prop_anyBP+ , testProperty "append" prop_appendBP+ , testProperty "compare" prop_compareBP+ , testProperty "concat" prop_concatBP+ , testProperty "cons" prop_consBP+ , testProperty "cons'" prop_consBP'+ , testProperty "uncons" prop_unconsBP+ , testProperty "unsnoc" prop_unsnocBP+ , testProperty "eq" prop_eqBP+ , testProperty "filter" prop_filterBP+ , testProperty "find" prop_findBP+ , testProperty "findIndex" prop_findIndexBP+ , testProperty "findIndexEnd"prop_findIndexEndBP+ , testProperty "findIndices" prop_findIndicesBP+ , testProperty "foldl" prop_foldlBP+ , testProperty "foldl'" prop_foldlBP'+ , testProperty "foldl1" prop_foldl1BP+ , testProperty "foldl1'" prop_foldl1BP'+ , testProperty "foldr" prop_foldrBP+ , testProperty "foldr'" prop_foldrBP'+ , testProperty "foldr1" prop_foldr1BP+ , testProperty "foldr1'" prop_foldr1BP'+ , testProperty "mapAccumL" prop_mapAccumLBP+-- , testProperty "mapAccumL" prop_mapAccumL_mapIndexedBP+ , testProperty "unfoldr" prop_unfoldrBP+ , testProperty "unfoldr 2" prop_unfoldr2BP+ , testProperty "unfoldr 2" prop_unfoldr2CP+ , testProperty "head" prop_headBP+ , testProperty "init" prop_initBP+ , testProperty "isPrefixOf" prop_isPrefixOfBP+ , testProperty "isSuffixOf" prop_isSuffixOfBP+ , testProperty "stripPrefix" prop_stripPrefixBP+ , testProperty "stripSuffix" prop_stripSuffixBP+ , testProperty "last" prop_lastBP+ , testProperty "length" prop_lengthBP+ , testProperty "readInt" prop_readIntBP+ , testProperty "lines" prop_linesBP+ , testProperty "lines \\n" prop_linesNLBP+ , testProperty "map" prop_mapBP+ , testProperty "maximum " prop_maximumBP+ , testProperty "minimum" prop_minimumBP+ , testProperty "null" prop_nullBP+ , testProperty "reverse" prop_reverseBP+ , testProperty "snoc" prop_snocBP+ , testProperty "tail" prop_tailBP+ , testProperty "scanl" prop_scanlBP+ , testProperty "transpose" prop_transposeBP+ , testProperty "replicate" prop_replicateBP+ , testProperty "take" prop_takeBP+ , testProperty "drop" prop_dropBP+ , testProperty "splitAt" prop_splitAtBP+ , testProperty "takeWhile" prop_takeWhileBP+ , testProperty "dropWhile" prop_dropWhileBP+ , testProperty "break" prop_breakBP+ , testProperty "span" prop_spanBP+ , testProperty "split" prop_splitBP+ , testProperty "count" prop_countBP+ , testProperty "group" prop_groupBP+ , testProperty "groupBy" prop_groupByBP+ , testProperty "inits" prop_initsBP+ , testProperty "tails" prop_tailsBP+ , testProperty "elem" prop_elemBP+ , testProperty "notElem" prop_notElemBP+ , testProperty "elemIndex" prop_elemIndexBP+ , testProperty "elemIndexEnd"prop_elemIndexEndBP+ , testProperty "elemIndices" prop_elemIndicesBP+ , testProperty "intersperse" prop_intersperseBP+ , testProperty "concatMap" prop_concatMapBP+ ]++------------------------------------------------------------------------+-- ByteString <=> List++pl_tests =+ [ testProperty "all" prop_allPL+ , testProperty "any" prop_anyPL+ , testProperty "append" prop_appendPL+ , testProperty "compare" prop_comparePL+ , testProperty "concat" prop_concatPL+ , testProperty "cons" prop_consPL+ , testProperty "eq" prop_eqPL+ , testProperty "filter" prop_filterPL+ , testProperty "filter rules"prop_filterPL_rule+ , testProperty "filter rules"prop_filterLC_rule+ , testProperty "partition" prop_partitionPL+ , testProperty "partition" prop_partitionLL+ , testProperty "find" prop_findPL+ , testProperty "findIndex" prop_findIndexPL+ , testProperty "findIndexEnd"prop_findIndexEndPL+ , testProperty "findIndices" prop_findIndicesPL+ , testProperty "foldl" prop_foldlPL+ , testProperty "foldl'" prop_foldlPL'+ , testProperty "foldl1" prop_foldl1PL+ , testProperty "foldl1'" prop_foldl1PL'+ , testProperty "foldr1" prop_foldr1PL+ , testProperty "foldr" prop_foldrPL+ , testProperty "mapAccumL" prop_mapAccumLPL+ , testProperty "mapAccumR" prop_mapAccumRPL+ , testProperty "unfoldr" prop_unfoldrPL+ , testProperty "scanl" prop_scanlPL+ , testProperty "scanl1" prop_scanl1PL+ , testProperty "scanl1" prop_scanl1CL+ , testProperty "scanr" prop_scanrCL+ , testProperty "scanr" prop_scanrPL+ , testProperty "scanr1" prop_scanr1PL+ , testProperty "scanr1" prop_scanr1CL+ , testProperty "head" prop_headPL+ , testProperty "init" prop_initPL+ , testProperty "last" prop_lastPL+ , testProperty "maximum" prop_maximumPL+ , testProperty "minimum" prop_minimumPL+ , testProperty "tail" prop_tailPL+ , testProperty "zip" prop_zipPL+ , testProperty "zip" prop_zipLL+ , testProperty "zip" prop_zipCL+ , testProperty "unzip" prop_unzipPL+ , testProperty "unzip" prop_unzipLL+ , testProperty "unzip" prop_unzipCL+ , testProperty "unzip" prop_unzipDL+ , testProperty "zipWithPL" prop_zipWithPL+ , testProperty "zipWithPL rules" prop_zipWithPL_rules+ , testProperty "packZipWithPL" prop_packZipWithPL++ , testProperty "isPrefixOf" prop_isPrefixOfPL+ , testProperty "isSuffixOf" prop_isSuffixOfPL+ , testProperty "isInfixOf" prop_isInfixOfPL+ , testProperty "stripPrefix" prop_stripPrefixPL+ , testProperty "stripSuffix" prop_stripSuffixPL+ , testProperty "length" prop_lengthPL+ , testProperty "map" prop_mapPL+ , testProperty "null" prop_nullPL+ , testProperty "reverse" prop_reversePL+ , testProperty "snoc" prop_snocPL+ , testProperty "transpose" prop_transposePL+ , testProperty "replicate" prop_replicatePL+ , testProperty "take" prop_takePL+ , testProperty "drop" prop_dropPL+ , testProperty "splitAt" prop_splitAtPL+ , testProperty "takeWhile" prop_takeWhilePL+ , testProperty "dropWhile" prop_dropWhilePL+ , testProperty "break" prop_breakPL+ , testProperty "span" prop_spanPL+ , testProperty "group" prop_groupPL+ , testProperty "groupBy" prop_groupByPL+ , testProperty "inits" prop_initsPL+ , testProperty "tails" prop_tailsPL+ , testProperty "elem" prop_elemPL+ , testProperty "notElem" prop_notElemPL+ , testProperty "lines" prop_linesPL+ , testProperty "elemIndex" prop_elemIndexPL+ , testProperty "elemIndex" prop_elemIndexCL+ , testProperty "elemIndices" prop_elemIndicesPL+ , testProperty "concatMap" prop_concatMapPL+ , testProperty "IsString" prop_isstring+ , testProperty "IsString LC" prop_isstring_lc+ ]++------------------------------------------------------------------------+-- extra ByteString properties++bb_tests =+ [ testProperty "bijection" prop_bijectionBB+ , testProperty "bijection'" prop_bijectionBB'+ , testProperty "pack/unpack" prop_packunpackBB+ , testProperty "unpack/pack" prop_packunpackBB'+ , testProperty "eq 1" prop_eq1BB+ , testProperty "eq 2" prop_eq2BB+ , testProperty "eq 3" prop_eq3BB+ , testProperty "compare 1" prop_compare1BB+ , testProperty "compare 2" prop_compare2BB+ , testProperty "compare 3" prop_compare3BB+ , testProperty "compare 4" prop_compare4BB+ , testProperty "compare 5" prop_compare5BB+ , testProperty "compare 6" prop_compare6BB+ , testProperty "compare 7" prop_compare7BB+ , testProperty "compare 7" prop_compare7LL+ , testProperty "compare 8" prop_compare8BB+ , testProperty "empty 1" prop_nil1BB+ , testProperty "empty 2" prop_nil2BB+ , testProperty "empty 1 monoid" prop_nil1LL_monoid+ , testProperty "empty 2 monoid" prop_nil2LL_monoid+ , testProperty "empty 1 monoid" prop_nil1BB_monoid+ , testProperty "empty 2 monoid" prop_nil2BB_monoid++ , testProperty "null" prop_nullBB+ , testProperty "length 1" prop_lengthBB+ , testProperty "length 2" prop_lengthSBB+ , testProperty "cons 1" prop_consBB+ , testProperty "cons 2" prop_cons1BB+ , testProperty "cons 3" prop_cons2BB+ , testProperty "cons 4" prop_cons3BB+ , testProperty "cons 5" prop_cons4BB+ , testProperty "snoc" prop_snoc1BB+ , testProperty "head 1" prop_head1BB+ , testProperty "head 2" prop_head2BB+ , testProperty "head 3" prop_head3BB+ , testProperty "tail" prop_tailBB+ , testProperty "tail 1" prop_tail1BB+ , testProperty "last" prop_lastBB+ , testProperty "last 1" prop_last1BB+ , testProperty "init" prop_initBB+ , testProperty "init 1" prop_init1BB+ , testProperty "append 1" prop_append1BB+ , testProperty "append 2" prop_append2BB+ , testProperty "append 3" prop_append3BB+ , testProperty "mappend 1" prop_append1BB_monoid+ , testProperty "mappend 2" prop_append2BB_monoid+ , testProperty "mappend 3" prop_append3BB_monoid++ , testProperty "map 1" prop_map1BB+ , testProperty "map 2" prop_map2BB+ , testProperty "map 3" prop_map3BB+ , testProperty "filter1" prop_filter1BB+ , testProperty "filter2" prop_filter2BB+ , testProperty "map fusion" prop_mapfusionBB+ , testProperty "filter fusion" prop_filterfusionBB+ , testProperty "reverse 1" prop_reverse1BB+ , testProperty "reverse 2" prop_reverse2BB+ , testProperty "reverse 3" prop_reverse3BB+ , testProperty "foldl 1" prop_foldl1BB+ , testProperty "foldl 2" prop_foldl2BB+ , testProperty "foldr 1" prop_foldr1BB+ , testProperty "foldr 2" prop_foldr2BB+ , testProperty "foldl1 1" prop_foldl1_1BB+ , testProperty "foldl1 2" prop_foldl1_2BB+ , testProperty "foldl1 3" prop_foldl1_3BB+ , testProperty "foldr1 1" prop_foldr1_1BB+ , testProperty "foldr1 2" prop_foldr1_2BB+ , testProperty "foldr1 3" prop_foldr1_3BB+ , testProperty "scanl/foldl" prop_scanlfoldlBB+ , testProperty "all" prop_allBB+ , testProperty "any" prop_anyBB+ , testProperty "take" prop_takeBB+ , testProperty "drop" prop_dropBB+ , testProperty "takeWhile_ne" prop_takeWhileBB_ne+ , testProperty "takeWhile_eq" prop_takeWhileBB_eq+ , testProperty "dropWhile_ne" prop_dropWhileBB_ne+ , testProperty "dropWhile_eq" prop_dropWhileBB_eq+ , testProperty "dropWhile_isSpace" prop_dropWhileCC_isSpace+ , testProperty "splitAt" prop_splitAtBB+ , testProperty "span" prop_spanBB+ , testProperty "break" prop_breakBB+ , testProperty "elem" prop_elemBB+ , testProperty "notElem" prop_notElemBB++ , testProperty "concat 1" prop_concat1BB+ , testProperty "concat 2" prop_concat2BB+ , testProperty "concat 3" prop_concatBB+ , testProperty "mconcat 1" prop_concat1BB_monoid+ , testProperty "mconcat 2" prop_concat2BB_monoid+ , testProperty "mconcat 3" prop_concatBB_monoid++ , testProperty "mconcat 1" prop_concat1LL_monoid+ , testProperty "mconcat 2" prop_concat2LL_monoid+ , testProperty "mconcat 3" prop_concatLL_monoid++ , testProperty "lines" prop_linesBB+ , testProperty "unlines" prop_unlinesBB+ , testProperty "unlines" prop_unlinesLC+ , testProperty "lines_lazy1" prop_lines_lazy1+ , testProperty "lines_lazy2" prop_lines_lazy2+ , testProperty "words" prop_wordsBB+ , testProperty "words" prop_wordsLC+ , testProperty "unwords" prop_unwordsBB+ , testProperty "group" prop_groupBB+ , testProperty "groupBy 0" prop_groupByBB+ , testProperty "groupBy 1" prop_groupBy1CC+ , testProperty "groupBy 2" prop_groupBy1BB+ , testProperty "groupBy 3" prop_groupBy2CC+ , testProperty "join" prop_joinBB+ , testProperty "elemIndex 1" prop_elemIndex1BB+ , testProperty "elemIndex 2" prop_elemIndex2BB+ , testProperty "findIndex" prop_findIndexBB+ , testProperty "findIndexEnd" prop_findIndexEndBB+ , testProperty "findIndexEnd" prop_findIndexEndLL+ , testProperty "findIndexEnd" prop_findIndexEndDD+ , testProperty "findIndicies" prop_findIndiciesBB+ , testProperty "elemIndices" prop_elemIndicesBB+ , testProperty "find" prop_findBB+ , testProperty "find/findIndex" prop_find_findIndexBB+ , testProperty "sort 1" prop_sort1BB+ , testProperty "sort 2" prop_sort2BB+ , testProperty "sort 3" prop_sort3BB+ , testProperty "sort 4" prop_sort4BB+ , testProperty "sort 5" prop_sort5BB+ , testProperty "intersperse" prop_intersperseBB+ , testProperty "maximum" prop_maximumBB+ , testProperty "minimum" prop_minimumBB+ , testProperty "strip" prop_strip+-- , testProperty "breakChar" prop_breakCharBB+-- , testProperty "spanChar 1" prop_spanCharBB+-- , testProperty "spanChar 2" prop_spanChar_1BB+-- , testProperty "breakSpace" prop_breakSpaceBB+-- , testProperty "dropSpace" prop_dropSpaceBB+ , testProperty "spanEnd" prop_spanEndBB+ , testProperty "breakEnd" prop_breakEndBB+ , testProperty "breakEnd" prop_breakEndCC+ , testProperty "elemIndexEnd" prop_elemIndexEnd1BB+ , testProperty "elemIndexEnd" prop_elemIndexEnd1CC+ , testProperty "elemIndexEnd" prop_elemIndexEnd1LL+ , testProperty "elemIndexEnd" prop_elemIndexEnd1DD+-- , testProperty "words'" prop_wordsBB'+-- , testProperty "lines'" prop_linesBB'+-- , testProperty "dropSpaceEnd" prop_dropSpaceEndBB+ , testProperty "unfoldr" prop_unfoldrBB+ , testProperty "prefix" prop_prefixBB+ , testProperty "prefix" prop_prefixLL+ , testProperty "suffix" prop_suffixBB+ , testProperty "suffix" prop_suffixLL+ , testProperty "stripPrefix" prop_stripPrefixBB+ , testProperty "stripPrefix" prop_stripPrefixLL+ , testProperty "stripSuffix" prop_stripSuffixBB+ , testProperty "stripSuffix" prop_stripSuffixLL+ , testProperty "copy" prop_copyBB+ , testProperty "copy" prop_copyLL+ , testProperty "inits" prop_initsBB+ , testProperty "tails" prop_tailsBB+ , testProperty "breakSubstring 1"prop_breakSubstringBB+ , testProperty "breakSubstring 3"prop_breakSubstring_isInfixOf++ , testProperty "replicate1" prop_replicate1BB+ , testProperty "replicate2" prop_replicate2BB+ , testProperty "replicate3" prop_replicate3BB+ , testProperty "readInt" prop_readintBB+ , testProperty "readInt 2" prop_readint2BB+ , testProperty "readInteger" prop_readintegerBB+ , testProperty "readInteger 2" prop_readinteger2BB+ , testProperty "read" prop_readLL+ , testProperty "read" prop_readBB+ , testProperty "Lazy.readInt" prop_readintLL+ , testProperty "Lazy.readInt" prop_readintLL+ , testProperty "Lazy.readInteger" prop_readintegerLL++ , testProperty "readIntSafe" prop_readIntSafe+ , testProperty "readIntUnsafe" prop_readIntUnsafe+ , testProperty "readIntegerSafe" prop_readIntegerSafe+ , testProperty "readIntegerUnsafe" prop_readIntegerUnsafe++ , testProperty "mconcat 1" prop_append1LL_monoid+ , testProperty "mconcat 2" prop_append2LL_monoid+ , testProperty "mconcat 3" prop_append3LL_monoid+-- , testProperty "filterChar1" prop_filterChar1BB+-- , testProperty "filterChar2" prop_filterChar2BB+-- , testProperty "filterChar3" prop_filterChar3BB+-- , testProperty "filterNotChar1" prop_filterNotChar1BB+-- , testProperty "filterNotChar2" prop_filterNotChar2BB+ , testProperty "tail" prop_tailSBB+ , testProperty "index" prop_indexBB+ , testProperty "unsafeIndex" prop_unsafeIndexBB+-- , testProperty "map'" prop_mapBB'+ , testProperty "filter" prop_filterBB+ , testProperty "elem" prop_elemSBB+ , testProperty "take" prop_takeSBB+ , testProperty "drop" prop_dropSBB+ , testProperty "splitAt" prop_splitAtSBB+ , testProperty "foldl" prop_foldlBB+ , testProperty "foldr" prop_foldrBB+ , testProperty "takeWhile " prop_takeWhileSBB+ , testProperty "dropWhile " prop_dropWhileSBB+ , testProperty "span " prop_spanSBB+ , testProperty "break " prop_breakSBB+ , testProperty "breakspan" prop_breakspan_1BB+ , testProperty "lines " prop_linesSBB+ , testProperty "unlines " prop_unlinesSBB+ , testProperty "words " prop_wordsSBB+ , testProperty "unwords " prop_unwordsSBB+ , testProperty "unwords " prop_unwordsSLC+-- , testProperty "wordstokens" prop_wordstokensBB+ , testProperty "splitWith_empty" prop_splitWithBB_empty+ , testProperty "splitWith" prop_splitWithBB+ , testProperty "split_empty" prop_splitBB_empty+ , testProperty "joinsplit" prop_joinsplitBB+ , testProperty "intercalate" prop_intercalatePL+-- , testProperty "lineIndices" prop_lineIndices1BB+ , testProperty "count" prop_countBB+-- , testProperty "linessplit" prop_linessplit2BB+ , testProperty "splitsplitWith" prop_splitsplitWithBB+-- , testProperty "joinjoinpath" prop_joinjoinpathBB+ , testProperty "zip" prop_zipBB+ , testProperty "zip" prop_zipLC+ , testProperty "zip1" prop_zip1BB+ , testProperty "zipWithBB" prop_zipWithBB+ , testProperty "zipWithCC" prop_zipWithCC+ , testProperty "zipWithLC" prop_zipWithLC+ , testProperty "packZipWithBB" prop_packZipWithBB+ , testProperty "packZipWithLL" prop_packZipWithLL+ , testProperty "packZipWithBC" prop_packZipWithBC+ , testProperty "packZipWithLC" prop_packZipWithLC+ , testProperty "unzip" prop_unzipBB+ , testProperty "concatMap" prop_concatMapBB+-- , testProperty "join/joinByte" prop_join_spec+#if MIN_VERSION_base(4,9,0)+ , testProperty "stimes strict" prop_stimesBB+ , testProperty "stimes lazy" prop_stimesLL+#endif+ ]+++------------------------------------------------------------------------+-- Extra lazy properties++ll_tests =+ [ testProperty "eq 1" prop_eq1+ , testProperty "eq 2" prop_eq2+ , testProperty "eq 3" prop_eq3+ , testProperty "eq refl" prop_eq_refl+ , testProperty "eq symm" prop_eq_symm+ , testProperty "compare 1" prop_compare1+ , testProperty "compare 2" prop_compare2+ , testProperty "compare 3" prop_compare3+ , testProperty "compare 4" prop_compare4+ , testProperty "compare 5" prop_compare5+ , testProperty "compare 6" prop_compare6+ , testProperty "compare 7" prop_compare7+ , testProperty "compare 8" prop_compare8+ , testProperty "compare 9" prop_compare9+ , testProperty "empty 1" prop_empty1+ , testProperty "empty 2" prop_empty2+ , testProperty "pack/unpack" prop_packunpack+ , testProperty "unpack/pack" prop_unpackpack+ , testProperty "null" prop_null+ , testProperty "length 1" prop_length1+ , testProperty "length 2" prop_length2+ , testProperty "cons 1" prop_cons1+ , testProperty "cons 2" prop_cons2+ , testProperty "cons 3" prop_cons3+ , testProperty "cons 4" prop_cons4+ , testProperty "snoc" prop_snoc1+ , testProperty "head/pack" prop_head+ , testProperty "head/unpack" prop_head1+ , testProperty "tail/pack" prop_tail+ , testProperty "tail/unpack" prop_tail1+ , testProperty "last" prop_last+ , testProperty "init" prop_init+ , testProperty "append 1" prop_append1+ , testProperty "appendLazy" prop_appendLazy+ , testProperty "append 2" prop_append2+ , testProperty "append 3" prop_append3+ , testProperty "map 1" prop_map1+ , testProperty "map 2" prop_map2+ , testProperty "map 3" prop_map3+ , testProperty "filter 1" prop_filter1+ , testProperty "filter 2" prop_filter2+ , testProperty "reverse" prop_reverse+ , testProperty "reverse1" prop_reverse1+ , testProperty "reverse2" prop_reverse2+ , testProperty "transpose" prop_transpose+ , testProperty "foldl" prop_foldl+ , testProperty "foldl/reverse" prop_foldl_1+ , testProperty "foldr" prop_foldr+ , testProperty "foldr/id" prop_foldr_1+ , testProperty "foldl1/foldl" prop_foldl1_1+ , testProperty "foldl1/head" prop_foldl1_2+ , testProperty "foldl1/tail" prop_foldl1_3+ , testProperty "foldr1/foldr" prop_foldr1_1+ , testProperty "foldr1/last" prop_foldr1_2+ , testProperty "foldr1/head" prop_foldr1_3+ , testProperty "concat 1" prop_concat1+ , testProperty "concat 2" prop_concat2+ , testProperty "concat/pack" prop_concat3+ , testProperty "any" prop_any+ , testProperty "all" prop_all+ , testProperty "maximum" prop_maximum+ , testProperty "minimum" prop_minimum+ , testProperty "compareLength 1" prop_compareLength1+ , testProperty "compareLength 2" prop_compareLength2+ , testProperty "compareLength 3" prop_compareLength3+ , testProperty "compareLength 4" prop_compareLength4+ , testProperty "compareLength 5" prop_compareLength5+ , testProperty "replicate 1" prop_replicate1+ , testProperty "replicate 2" prop_replicate2+ , testProperty "take" prop_take1+ , testProperty "takeEnd" prop_takeEnd+ , testProperty "drop" prop_drop1+ , testProperty "dropEnd" prop_dropEnd+ , testProperty "splitAt" prop_drop1+ , testProperty "takeWhile" prop_takeWhile+ , testProperty "dropWhile" prop_dropWhile+ , testProperty "takeWhileEnd" prop_takeWhileEnd+ , testProperty "dropWhileEnd" prop_dropWhileEnd+ , testProperty "break" prop_break+ , testProperty "span" prop_span+ , testProperty "splitAt" prop_splitAt+ , testProperty "break/span" prop_breakspan+ , testProperty "split" prop_split+ , testProperty "splitWith_empty" prop_splitWith_empty+ , testProperty "splitWith" prop_splitWith+ , testProperty "splitWith_empty" prop_splitWith_D_empty+ , testProperty "splitWith" prop_splitWith_D+ , testProperty "splitWith_empty" prop_splitWith_C_empty+ , testProperty "splitWith" prop_splitWith_C+ , testProperty "split_empty" prop_split_empty+ , testProperty "join.split/id" prop_joinsplit+-- , testProperty "join/joinByte" prop_joinjoinByte+ , testProperty "group" prop_group+ , testProperty "groupBy" prop_groupBy+ , testProperty "groupBy" prop_groupBy_LC+ , testProperty "index" prop_index+ , testProperty "index" prop_index_D+ , testProperty "index" prop_index_C+ , testProperty "indexMaybe" prop_indexMaybe_Just_P+ , testProperty "indexMaybe" prop_indexMaybe_Just_L+ , testProperty "indexMaybe" prop_indexMaybe_Nothing_P+ , testProperty "indexMaybe" prop_indexMaybe_Nothing_L+ , testProperty "elemIndex" prop_elemIndex+ , testProperty "elemIndices" prop_elemIndices+ , testProperty "count/elemIndices" prop_count+ , testProperty "findIndex" prop_findIndex+ , testProperty "findIndexEnd" prop_findIndexEnd+ , testProperty "findIndices" prop_findIndicies+ , testProperty "find" prop_find+ , testProperty "find/findIndex" prop_find_findIndex+ , testProperty "elem" prop_elem+ , testProperty "notElem" prop_notElem+ , testProperty "elem/notElem" prop_elem_notelem+-- , testProperty "filterByte 1" prop_filterByte+-- , testProperty "filterByte 2" prop_filterByte2+-- , testProperty "filterNotByte 1" prop_filterNotByte+-- , testProperty "filterNotByte 2" prop_filterNotByte2+ , testProperty "isPrefixOf" prop_isPrefixOf+ , testProperty "isSuffixOf" prop_isSuffixOf+ , testProperty "stripPrefix" prop_stripPrefix+ , testProperty "stripSuffix" prop_stripSuffix+ , testProperty "concatMap" prop_concatMap+ , testProperty "isSpace" prop_isSpaceWord8+ ]++findIndexEnd :: (a -> Bool) -> [a] -> Maybe Int+findIndexEnd p = go . findIndices p+ where+ go [] = Nothing+ go (k:[]) = Just k+ go (k:ks) = go ks++elemIndexEnd :: Eq a => a -> [a] -> Maybe Int+elemIndexEnd = findIndexEnd . (==)++removeFile :: String -> IO ()+removeFile fn = void $ withCString fn c_unlink
+ tests/QuickCheckUtils.hs view
@@ -0,0 +1,197 @@+{-# LANGUAGE CPP, MultiParamTypeClasses,+ FlexibleInstances, FlexibleContexts,+ TypeSynonymInstances #-}+--+-- Uses multi-param type classes+--+module QuickCheckUtils where++import Test.Tasty.QuickCheck+import Text.Show.Functions++import Control.Monad ( liftM2 )+import Data.Char+import Data.List+import Data.Word+import Data.Int+import System.IO+import Foreign.C (CChar)++import qualified Data.ByteString as P+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.Internal as L (checkInvariant,ByteString(..))++import qualified Data.ByteString.Char8 as PC+import qualified Data.ByteString.Lazy.Char8 as LC++------------------------------------------------------------------------++sizedByteString n = do m <- choose(0, n)+ fmap P.pack $ vectorOf m arbitrary++instance Arbitrary P.ByteString where+ arbitrary = do+ bs <- sized sizedByteString+ n <- choose (0, 2)+ return (P.drop n bs) -- to give us some with non-0 offset++instance CoArbitrary P.ByteString where+ coarbitrary s = coarbitrary (P.unpack s)++instance Arbitrary L.ByteString where+ arbitrary = sized $ \n -> do numChunks <- choose (0, n)+ if numChunks == 0+ then return L.empty+ else fmap (L.checkInvariant .+ L.fromChunks .+ filter (not . P.null)) $+ vectorOf numChunks+ (sizedByteString+ (n `div` numChunks))++instance CoArbitrary L.ByteString where+ coarbitrary s = coarbitrary (L.unpack s)++newtype CByteString = CByteString P.ByteString+ deriving Show++instance Arbitrary CByteString where+ arbitrary = fmap (CByteString . P.pack . map fromCChar)+ arbitrary+ where+ fromCChar :: NonZero CChar -> Word8+ fromCChar = fromIntegral . getNonZero++-- | 'Char', but only representing 8-bit characters.+--+newtype Char8 = Char8 Char+ deriving (Eq, Ord, Show)++instance Arbitrary Char8 where+ arbitrary = fmap (Char8 . toChar) arbitrary+ where+ toChar :: Word8 -> Char+ toChar = toEnum . fromIntegral++instance CoArbitrary Char8 where+ coarbitrary (Char8 c) = coarbitrary c++-- | 'Char', but only representing 8-bit characters.+--+newtype String8 = String8 String+ deriving (Eq, Ord, Show)++instance Arbitrary String8 where+ arbitrary = fmap (String8 . map toChar) arbitrary+ where+ toChar :: Word8 -> Char+ toChar = toEnum . fromIntegral++------------------------------------------------------------------------+--+-- We're doing two forms of testing here. Firstly, model based testing.+-- For our Lazy and strict bytestring types, we have model types:+--+-- i.e. Lazy == Byte+-- \\ //+-- List+--+-- That is, the Lazy type can be modeled by functions in both the Byte+-- and List type. For each of the 3 models, we have a set of tests that+-- check those types match.+--+-- The Model class connects a type and its model type, via a conversion+-- function.+--+--+class Model a b where+ model :: a -> b -- ^ Get the abstract value from a concrete value++-- | Alias for 'model' that's a better name in the situations where we're+-- really just converting functions that take or return Char8.+castFn :: Model a b => a -> b+castFn = model++--+-- Connecting our Lazy and Strict types to their models. We also check+-- the data invariant on Lazy types.+--+-- These instances represent the arrows in the above diagram+--+instance Model B P where model = abstr . checkInvariant+instance Model P [W] where model = P.unpack+instance Model P [Char] where model = PC.unpack+instance Model B [W] where model = L.unpack . checkInvariant+instance Model B [Char] where model = LC.unpack . checkInvariant+instance Model Char8 Char where model (Char8 c) = c++-- Types are trivially modeled by themselves+instance Model Bool Bool where model = id+instance Model Int Int where model = id+instance Model P P where model = id+instance Model B B where model = id+instance Model Int64 Int64 where model = id+instance Model Word8 Word8 where model = id+instance Model Ordering Ordering where model = id+instance Model Char Char where model = id++-- More structured types are modeled recursively, using the NatTrans class from Gofer.+class (Functor f, Functor g) => NatTrans f g where+ eta :: f a -> g a++-- The transformation of the same type is identity+instance NatTrans [] [] where eta = id+instance NatTrans Maybe Maybe where eta = id+instance NatTrans ((->) X) ((->) X) where eta = id+instance NatTrans ((->) Char) ((->) Char) where eta = id+instance NatTrans ((->) Char8) ((->) Char) where eta f = f . Char8++instance NatTrans ((->) W) ((->) W) where eta = id++-- We have a transformation of pairs, if the pairs are in Model+instance Model f g => NatTrans ((,) f) ((,) g) where eta (f,a) = (model f, a)++-- And finally, we can take any (m a) to (n b), if we can Model m n, and a b+instance (NatTrans m n, Model a b) => Model (m a) (n b) where model x = fmap model (eta x)++------------------------------------------------------------------------++-- In a form more useful for QC testing (and it's lazy)+checkInvariant :: L.ByteString -> L.ByteString+checkInvariant = L.checkInvariant++abstr :: L.ByteString -> P.ByteString+abstr = P.concat . L.toChunks++-- Some short hand.+type X = Int+type W = Word8+type P = P.ByteString+type B = L.ByteString++------------------------------------------------------------------------+--+-- These comparison functions handle wrapping and equality.+--+-- A single class for these would be nice, but note that they differe in+-- the number of arguments, and those argument types, so we'd need HList+-- tricks. See here: http://okmij.org/ftp/Haskell/vararg-fn.lhs+--++eq1 f g = \a ->+ model (f a) == g (model a)+eq2 f g = \a b ->+ model (f a b) == g (model a) (model b)+eq3 f g = \a b c ->+ model (f a b c) == g (model a) (model b) (model c)++--+-- And for functions that take non-null input+--+eqnotnull1 f g = \x -> (not (isNull x)) ==> eq1 f g x+eqnotnull2 f g = \x y -> (not (isNull y)) ==> eq2 f g x y+eqnotnull3 f g = \x y z -> (not (isNull z)) ==> eq3 f g x y z++class IsNull t where isNull :: t -> Bool+instance IsNull L.ByteString where isNull = L.null+instance IsNull P.ByteString where isNull = P.null
+ tests/Rules.hs view
@@ -0,0 +1,41 @@+module Rules where+--+-- Tests to ensure rules are firing.+--++import qualified Data.ByteString.Char8 as C+import qualified Data.ByteString as P+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.Char8 as D+import Data.List+import Data.Char+import Data.Word++import QuickCheckUtils++import Test.Tasty.QuickCheck++prop_break_C :: Word8 -> C.ByteString -> Bool+prop_break_C w = C.break ((==) x) `eq1` break ((==) x)+ where+ -- Make sure we're not testing non-octet character values, for which+ -- C.break is not isomorphic to breaking the corresponding string,+ -- Instead start with a byte, and make a character out of that.+ x = chr $ fromIntegral w++prop_break_P :: Word8 -> C.ByteString -> Bool+prop_break_P x = P.break ((==) x) `eq1` break ((==) x)+prop_intercalate_P c = (\s1 s2 -> P.intercalate (P.singleton c) (s1 : s2 : []))+ `eq2`+ (\s1 s2 -> intercalate [c] (s1 : s2 : []))++prop_break_isSpace_C = C.break isSpace `eq1` break isSpace+prop_dropWhile_isSpace_C = C.dropWhile isSpace `eq1` dropWhile isSpace++rules =+ [ testProperty "break (==)" prop_break_C+ , testProperty "break (==)" prop_break_P+ , testProperty "break isSpace" prop_break_isSpace_C+ , testProperty "dropWhile isSpace" prop_dropWhile_isSpace_C+ , testProperty "intercalate" prop_intercalate_P+ ]
+ tests/builder/Data/ByteString/Builder/Prim/TestUtils.hs view
@@ -0,0 +1,364 @@+{-# LANGUAGE ScopedTypeVariables #-}+-- |+-- Copyright : (c) 2011 Simon Meier+-- License : BSD3-style (see LICENSE)+--+-- Maintainer : Simon Meier <iridcode@gmail.com>+-- Stability : experimental+-- Portability : tested on GHC only+--+-- Testing utilities for comparing+-- for an example on how to use the functions provided here.+--+module Data.ByteString.Builder.Prim.TestUtils (++ -- * Showing+ evalF+ , evalB++ , showF+ , showB++ -- * Testing 'FixedPrim's+ , testF+ , testBoundedF++ , testFixedBoundF++ , compareImpls++ -- * Testing 'BoundedPrim's+ , testBoundedB++ -- * Encoding reference implementations++ , charUtf8_list+ , char8_list++ -- ** ASCII-based encodings+ , encodeASCII+ , encodeForcedASCII+ , char7_list+ , dec_list+ , hex_list+ , wordHexFixed_list+ , int8HexFixed_list+ , int16HexFixed_list+ , int32HexFixed_list+ , int64HexFixed_list+ , floatHexFixed_list+ , doubleHexFixed_list++ -- ** Binary+ , parseVar++ , bigEndian_list+ , littleEndian_list+ , hostEndian_list+ , float_list+ , double_list+ , coerceFloatToWord32+ , coerceDoubleToWord64++ ) where++import Control.Arrow (first)++import Data.ByteString.Builder.Prim++import qualified Data.ByteString as S+import qualified Data.ByteString.Internal as S+import qualified Data.ByteString.Builder.Prim.Internal as I++import Data.Bits (Bits(..))+import Data.Char (chr, ord)+import Data.Int+import Data.Word+import Foreign (Storable(..), castPtr, minusPtr, with)+import Numeric (showHex)+import GHC.ByteOrder+import System.IO.Unsafe (unsafePerformIO)++import Test.Tasty+import Test.Tasty.HUnit (assertBool, testCase)+import Test.Tasty.QuickCheck (Arbitrary(..), testProperty)++-- Helper functions+-------------------++-- | Quickcheck test that includes a check that the property holds on the+-- bounds of a bounded value.+testBoundedProperty :: forall a. (Arbitrary a, Show a, Bounded a)+ => String -> (a -> Bool) -> TestTree+testBoundedProperty name p = testGroup name+ [ testProperty name p+ , testCase (name ++ " minBound") $ assertBool "minBound" (p (minBound :: a))+ , testCase (name ++ " maxBound") $ assertBool "minBound" (p (maxBound :: a))+ ]++-- | Quote a 'String' nicely.+quote :: String -> String+quote cs = '`' : cs ++ "'"++-- | Quote a @[Word8]@ list as as 'String'.+quoteWord8s :: [Word8] -> String+quoteWord8s = quote . map (chr . fromIntegral)+++------------------------------------------------------------------------------+-- Testing encodings+------------------------------------------------------------------------------++-- | /For testing use only./ Evaluate a 'FixedPrim' on a given value.+evalF :: FixedPrim a -> a -> [Word8]+evalF fe = S.unpack . S.unsafeCreate (I.size fe) . I.runF fe++-- | /For testing use only./ Evaluate a 'BoundedPrim' on a given value.+evalB :: BoundedPrim a -> a -> [Word8]+evalB be x = S.unpack $ unsafePerformIO $+ S.createAndTrim (I.sizeBound be) $ \op -> do+ op' <- I.runB be x op+ return (op' `minusPtr` op)++-- | /For testing use only./ Show the result of a 'FixedPrim' of a given+-- value as a 'String' by interpreting the resulting bytes as Unicode+-- codepoints.+showF :: FixedPrim a -> a -> String+showF fe = map (chr . fromIntegral) . evalF fe++-- | /For testing use only./ Show the result of a 'BoundedPrim' of a given+-- value as a 'String' by interpreting the resulting bytes as Unicode+-- codepoints.+showB :: BoundedPrim a -> a -> String+showB be = map (chr . fromIntegral) . evalB be+++-- FixedPrim+----------------++-- TODO: Port code that checks for low-level properties of basic encodings (no+-- overwrites, all bytes written, etc.) from old 'system-io-write' library++-- | Test a 'FixedPrim' against a reference implementation.+testF :: (Arbitrary a, Show a)+ => String+ -> (a -> [Word8])+ -> FixedPrim a+ -> TestTree+testF name ref fe =+ testProperty name prop+ where+ prop x+ | y == y' = True+ | otherwise = error $ unlines $+ [ "testF: results disagree for " ++ quote (show x)+ , " fixed encoding: " ++ show y ++ " " ++ quoteWord8s y+ , " reference: " ++ show y'++ " " ++ quoteWord8s y'+ ]+ where+ y = evalF fe x+ y' = ref x++-- | Test a 'FixedPrim' of a bounded value against a reference implementation+-- and ensure that the bounds are always included as testcases.+testBoundedF :: (Arbitrary a, Bounded a, Show a)+ => String+ -> (a -> [Word8])+ -> FixedPrim a+ -> TestTree+testBoundedF name ref fe =+ testBoundedProperty name $ \x -> evalF fe x == ref x++-- FixedPrim derived from a bound on a given value.++testFixedBoundF :: (Arbitrary a, Show a, Integral a)+ => String+ -> (a -> a -> [Word8])+ -> (a -> FixedPrim a)+ -> TestTree+testFixedBoundF name ref bfe =+ testProperty name prop+ where+ prop (b, x0)+ | y == y' = True+ | otherwise = error $ unlines $+ [ "testF: results disagree for " ++ quote (show (b, x))+ , " fixed encoding: " ++ show y ++ " " ++ quoteWord8s y+ , " reference: " ++ show y'++ " " ++ quoteWord8s y'+ ]+ where+ x | b == 0 = 0+ | otherwise = x0 `mod` b+ y = evalF (bfe b) x+ y' = ref b x+++-- BoundedPrim+------------------++-- | Test a 'BoundedPrim' of a bounded value against a reference implementation+-- and ensure that the bounds are always included as testcases.+testBoundedB :: (Arbitrary a, Bounded a, Show a)+ => String+ -> (a -> [Word8])+ -> BoundedPrim a+ -> TestTree+testBoundedB name ref fe =+ testBoundedProperty name check+ where+ check x+ | y == y' = True+ | otherwise = error $ unlines $+ [ "testBoundedB: results disagree for " ++ quote (show x)+ , " fixed encoding: " ++ show y ++ " " ++ quoteWord8s y+ , " reference: " ++ show y'++ " " ++ quoteWord8s y'+ ]+ where+ y = evalB fe x+ y' = ref x++-- | Compare two implementations of a function.+compareImpls :: (Arbitrary a, Show a, Show b, Eq b)+ => TestName -> (a -> b) -> (a -> b) -> TestTree+compareImpls name f1 f2 =+ testProperty name check+ where+ check x+ | y1 == y2 = True+ | otherwise = error $ unlines $+ [ "compareImpls: results disagree for " ++ quote (show x)+ , " f1: " ++ show y1+ , " f2: " ++ show y2+ ]+ where+ y1 = f1 x+ y2 = f2 x++++------------------------------------------------------------------------------+-- Encoding reference implementations+------------------------------------------------------------------------------++-- | Char8 encoding: truncate Unicode codepoint to 8-bits.+char8_list :: Char -> [Word8]+char8_list = return . fromIntegral . ord++-- | Encode a Haskell String to a list of Word8 values, in UTF8 format.+--+-- Copied from 'utf8-string-0.3.6' to make tests self-contained.+-- Copyright (c) 2007, Galois Inc. All rights reserved.+--+charUtf8_list :: Char -> [Word8]+charUtf8_list =+ map fromIntegral . encode . ord+ where+ encode oc+ | oc <= 0x7f = [oc]++ | oc <= 0x7ff = [ 0xc0 + (oc `shiftR` 6)+ , 0x80 + oc .&. 0x3f+ ]++ | oc <= 0xffff = [ 0xe0 + (oc `shiftR` 12)+ , 0x80 + ((oc `shiftR` 6) .&. 0x3f)+ , 0x80 + oc .&. 0x3f+ ]+ | otherwise = [ 0xf0 + (oc `shiftR` 18)+ , 0x80 + ((oc `shiftR` 12) .&. 0x3f)+ , 0x80 + ((oc `shiftR` 6) .&. 0x3f)+ , 0x80 + oc .&. 0x3f+ ]++-- ASCII-based encodings+------------------------++-- | Encode a 'String' of only ASCII characters using the ASCII encoding.+encodeASCII :: String -> [Word8]+encodeASCII =+ map encode+ where+ encode c+ | c < '\x7f' = fromIntegral $ ord c+ | otherwise = error $ "encodeASCII: non-ASCII character '" ++ [c] ++ "'"++-- | Encode an arbitrary 'String' by truncating its characters to the least+-- significant 7-bits.+encodeForcedASCII :: String -> [Word8]+encodeForcedASCII = map ((.&. 0x7f) . fromIntegral . ord)++char7_list :: Char -> [Word8]+char7_list = encodeForcedASCII . return++dec_list :: Show a => a -> [Word8]+dec_list = encodeASCII . show++hex_list :: (Integral a, Show a) => a -> [Word8]+hex_list = encodeASCII . (\x -> showHex x "")++wordHexFixed_list :: (Storable a, Integral a, Show a) => a -> [Word8]+wordHexFixed_list x =+ encodeASCII $ pad (2 * sizeOf x) $ showHex x ""+ where+ pad n cs = replicate (n - length cs) '0' ++ cs++int8HexFixed_list :: Int8 -> [Word8]+int8HexFixed_list = wordHexFixed_list . (fromIntegral :: Int8 -> Word8 )++int16HexFixed_list :: Int16 -> [Word8]+int16HexFixed_list = wordHexFixed_list . (fromIntegral :: Int16 -> Word16)++int32HexFixed_list :: Int32 -> [Word8]+int32HexFixed_list = wordHexFixed_list . (fromIntegral :: Int32 -> Word32)++int64HexFixed_list :: Int64 -> [Word8]+int64HexFixed_list = wordHexFixed_list . (fromIntegral :: Int64 -> Word64)++floatHexFixed_list :: Float -> [Word8]+floatHexFixed_list = float_list wordHexFixed_list++doubleHexFixed_list :: Double -> [Word8]+doubleHexFixed_list = double_list wordHexFixed_list++-- Binary+---------++bigEndian_list :: (Storable a, Bits a, Integral a) => a -> [Word8]+bigEndian_list = reverse . littleEndian_list++littleEndian_list :: (Storable a, Bits a, Integral a) => a -> [Word8]+littleEndian_list x =+ map (fromIntegral . (x `shiftR`) . (8*)) $ [0..sizeOf x - 1]++hostEndian_list :: (Storable a, Bits a, Integral a) => a -> [Word8]+hostEndian_list = case targetByteOrder of+ LittleEndian -> littleEndian_list+ BigEndian -> bigEndian_list++float_list :: (Word32 -> [Word8]) -> Float -> [Word8]+float_list f = f . coerceFloatToWord32++double_list :: (Word64 -> [Word8]) -> Double -> [Word8]+double_list f = f . coerceDoubleToWord64++-- | Convert a 'Float' to a 'Word32'.+{-# NOINLINE coerceFloatToWord32 #-}+coerceFloatToWord32 :: Float -> Word32+coerceFloatToWord32 x = unsafePerformIO (with x (peek . castPtr))++-- | Convert a 'Double' to a 'Word64'.+{-# NOINLINE coerceDoubleToWord64 #-}+coerceDoubleToWord64 :: Double -> Word64+coerceDoubleToWord64 x = unsafePerformIO (with x (peek . castPtr))++-- | Parse a variable length encoding+parseVar :: (Num a, Bits a) => [Word8] -> (a, [Word8])+parseVar =+ go+ where+ go [] = error "parseVar: unterminated variable length int"+ go (w:ws)+ | w .&. 0x80 == 0 = (fromIntegral w, ws)+ | otherwise = first add (go ws)+ where+ add x = (x `shiftL` 7) .|. (fromIntegral w .&. 0x7f)
+ tests/builder/Data/ByteString/Builder/Prim/Tests.hs view
@@ -0,0 +1,174 @@+{-# LANGUAGE MagicHash #-}++-- |+-- Copyright : (c) 2011 Simon Meier+-- License : BSD3-style (see LICENSE)+--+-- Maintainer : Simon Meier <iridcode@gmail.com>+-- Stability : experimental+-- Portability : tested on GHC only+--+-- Testing all encodings provided by this library.++module Data.ByteString.Builder.Prim.Tests (tests) where++import Data.Char (ord)+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.Char8 as LC+import Data.ByteString.Builder+import qualified Data.ByteString.Builder.Prim as BP+import Data.ByteString.Builder.Prim.TestUtils++import Test.Tasty+import Test.Tasty.QuickCheck++tests :: [TestTree]+tests = concat [ testsBinary, testsASCII, testsChar8, testsUtf8+ , testsCombinatorsB, [testCString, testCStringUtf8] ]++testCString :: TestTree+testCString = testProperty "cstring" $+ toLazyByteString (BP.cstring "hello world!"#) ==+ LC.pack "hello" `L.append` L.singleton 0x20 `L.append` LC.pack "world!"++testCStringUtf8 :: TestTree+testCStringUtf8 = testProperty "cstringUtf8" $+ toLazyByteString (BP.cstringUtf8 "hello\xc0\x80world!"#) ==+ LC.pack "hello" `L.append` L.singleton 0x00 `L.append` LC.pack "world!"++------------------------------------------------------------------------------+-- Binary+------------------------------------------------------------------------------++testsBinary :: [TestTree]+testsBinary =+ [ testBoundedF "word8" bigEndian_list BP.word8+ , testBoundedF "int8" bigEndian_list BP.int8++ -- big-endian+ , testBoundedF "int16BE" bigEndian_list BP.int16BE+ , testBoundedF "int32BE" bigEndian_list BP.int32BE+ , testBoundedF "int64BE" bigEndian_list BP.int64BE++ , testBoundedF "word16BE" bigEndian_list BP.word16BE+ , testBoundedF "word32BE" bigEndian_list BP.word32BE+ , testBoundedF "word64BE" bigEndian_list BP.word64BE++ , testF "floatLE" (float_list littleEndian_list) BP.floatLE+ , testF "doubleLE" (double_list littleEndian_list) BP.doubleLE++ -- little-endian+ , testBoundedF "int16LE" littleEndian_list BP.int16LE+ , testBoundedF "int32LE" littleEndian_list BP.int32LE+ , testBoundedF "int64LE" littleEndian_list BP.int64LE++ , testBoundedF "word16LE" littleEndian_list BP.word16LE+ , testBoundedF "word32LE" littleEndian_list BP.word32LE+ , testBoundedF "word64LE" littleEndian_list BP.word64LE++ , testF "floatBE" (float_list bigEndian_list) BP.floatBE+ , testF "doubleBE" (double_list bigEndian_list) BP.doubleBE++ -- host dependent+ , testBoundedF "int16Host" hostEndian_list BP.int16Host+ , testBoundedF "int32Host" hostEndian_list BP.int32Host+ , testBoundedF "int64Host" hostEndian_list BP.int64Host+ , testBoundedF "intHost" hostEndian_list BP.intHost++ , testBoundedF "word16Host" hostEndian_list BP.word16Host+ , testBoundedF "word32Host" hostEndian_list BP.word32Host+ , testBoundedF "word64Host" hostEndian_list BP.word64Host+ , testBoundedF "wordHost" hostEndian_list BP.wordHost++ , testF "floatHost" (float_list hostEndian_list) BP.floatHost+ , testF "doubleHost" (double_list hostEndian_list) BP.doubleHost+ ]+++------------------------------------------------------------------------------+-- Latin-1 aka Char8+------------------------------------------------------------------------------++testsChar8 :: [TestTree]+testsChar8 =+ [ testBoundedF "char8" char8_list BP.char8 ]+++------------------------------------------------------------------------------+-- ASCII+------------------------------------------------------------------------------++testsASCII :: [TestTree]+testsASCII =+ [ testBoundedF "char7" char7_list BP.char7++ , testBoundedB "int8Dec" dec_list BP.int8Dec+ , testBoundedB "int16Dec" dec_list BP.int16Dec+ , testBoundedB "int32Dec" dec_list BP.int32Dec+ , testBoundedB "int64Dec" dec_list BP.int64Dec+ , testBoundedB "intDec" dec_list BP.intDec++ , testBoundedB "word8Dec" dec_list BP.word8Dec+ , testBoundedB "word16Dec" dec_list BP.word16Dec+ , testBoundedB "word32Dec" dec_list BP.word32Dec+ , testBoundedB "word64Dec" dec_list BP.word64Dec+ , testBoundedB "wordDec" dec_list BP.wordDec++ , testBoundedB "word8Hex" hex_list BP.word8Hex+ , testBoundedB "word16Hex" hex_list BP.word16Hex+ , testBoundedB "word32Hex" hex_list BP.word32Hex+ , testBoundedB "word64Hex" hex_list BP.word64Hex+ , testBoundedB "wordHex" hex_list BP.wordHex++ , testBoundedF "word8HexFixed" wordHexFixed_list BP.word8HexFixed+ , testBoundedF "word16HexFixed" wordHexFixed_list BP.word16HexFixed+ , testBoundedF "word32HexFixed" wordHexFixed_list BP.word32HexFixed+ , testBoundedF "word64HexFixed" wordHexFixed_list BP.word64HexFixed++ , testBoundedF "int8HexFixed" int8HexFixed_list BP.int8HexFixed+ , testBoundedF "int16HexFixed" int16HexFixed_list BP.int16HexFixed+ , testBoundedF "int32HexFixed" int32HexFixed_list BP.int32HexFixed+ , testBoundedF "int64HexFixed" int64HexFixed_list BP.int64HexFixed++ , testF "floatHexFixed" floatHexFixed_list BP.floatHexFixed+ , testF "doubleHexFixed" doubleHexFixed_list BP.doubleHexFixed+ ]+++------------------------------------------------------------------------------+-- UTF-8+------------------------------------------------------------------------------++testsUtf8 :: [TestTree]+testsUtf8 =+ [ testBoundedB "charUtf8" charUtf8_list BP.charUtf8 ]+++------------------------------------------------------------------------------+-- BoundedPrim combinators+------------------------------------------------------------------------------++maybeB :: BP.BoundedPrim () -> BP.BoundedPrim a -> BP.BoundedPrim (Maybe a)+maybeB nothing just = maybe (Left ()) Right BP.>$< BP.eitherB nothing just++testsCombinatorsB :: [TestTree]+testsCombinatorsB =+ [ compareImpls "mapMaybe (via BoundedPrim)"+ (L.pack . concatMap encChar)+ (toLazyByteString . encViaBuilder)++ , compareImpls "filter (via BoundedPrim)"+ (L.pack . filter (< 32))+ (toLazyByteString . BP.primMapListBounded (BP.condB (< 32) (BP.liftFixedToBounded BP.word8) BP.emptyB))++ , compareImpls "pairB"+ (L.pack . concatMap (\(c,w) -> charUtf8_list c ++ [w]))+ (toLazyByteString . BP.primMapListBounded+ ((\(c,w) -> (c,(w,undefined))) BP.>$<+ BP.charUtf8 BP.>*< (BP.liftFixedToBounded BP.word8) BP.>*< (BP.liftFixedToBounded BP.emptyF)))+ ]+ where+ encChar = maybe [112] (hostEndian_list . ord)++ encViaBuilder = BP.primMapListBounded $ maybeB (BP.liftFixedToBounded $ (\_ -> 112) BP.>$< BP.word8)+ (ord BP.>$< (BP.liftFixedToBounded $ BP.intHost))
+ tests/builder/Data/ByteString/Builder/Tests.hs view
@@ -0,0 +1,614 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- |+-- Copyright : (c) 2011 Simon Meier+-- License : BSD3-style (see LICENSE)+--+-- Maintainer : Simon Meier <iridcode@gmail.com>+-- Stability : experimental+-- Portability : tested on GHC only+--+-- Testing composition of 'Builders'.++module Data.ByteString.Builder.Tests (tests) where++import Control.Applicative+import Control.Monad (unless, void)+import Control.Monad.Trans.State (StateT, evalStateT, evalState, put, get)+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Writer (WriterT, execWriterT, tell)++import Foreign (minusPtr)++import Data.Char (chr)+import qualified Data.DList as D+import Data.Foldable+import Data.Word++import qualified Data.ByteString as S+import qualified Data.ByteString.Internal as S+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Short as Sh++import Data.ByteString.Builder+import Data.ByteString.Builder.Extra+import Data.ByteString.Builder.Internal (Put, putBuilder, fromPut)+import qualified Data.ByteString.Builder.Internal as BI+import qualified Data.ByteString.Builder.Prim as BP+import Data.ByteString.Builder.Prim.TestUtils++import Control.Exception (evaluate)+import System.IO (openTempFile, hPutStr, hClose, hSetBinaryMode, hSetEncoding, utf8, hSetNewlineMode, noNewlineTranslation)+import Foreign (ForeignPtr, withForeignPtr, castPtr)+import Foreign.C.String (withCString)+import System.Posix.Internals (c_unlink)++import Test.Tasty (TestTree, TestName, testGroup)+import Test.Tasty.QuickCheck+ ( Arbitrary(..), oneof, choose, listOf, elements+ , counterexample, ioProperty, UnicodeString(..), Property, testProperty )+++tests :: [TestTree]+tests =+ [ testBuilderRecipe+ , testHandlePutBuilder+ , testHandlePutBuilderChar8+ , testPut+ , testRunBuilder+ ] +++ testsEncodingToBuilder +++ testsBinary +++ testsASCII +++ testsChar8 +++ testsUtf8+++------------------------------------------------------------------------------+-- Testing 'Builder' execution+------------------------------------------------------------------------------++testBuilderRecipe :: TestTree+testBuilderRecipe =+ testProperty "toLazyByteStringWith" $ testRecipe <$> arbitrary+ where+ testRecipe r =+ counterexample msg $ x1 == x2+ where+ x1 = renderRecipe r+ x2 = buildRecipe r+ toString = map (chr . fromIntegral)+ msg = unlines+ [ "recipe: " ++ show r+ , "render: " ++ toString x1+ , "build : " ++ toString x2+ , "diff : " ++ show (dropWhile (uncurry (==)) $ zip x1 x2)+ ]++testHandlePutBuilder :: TestTree+testHandlePutBuilder =+ testProperty "hPutBuilder" testRecipe+ where+ testRecipe :: (UnicodeString, UnicodeString, UnicodeString, Recipe) -> Property+ testRecipe args =+ ioProperty $ do+ let (UnicodeString a1, UnicodeString a2, UnicodeString a3, recipe) = args+#if MIN_VERSION_base(4,5,0)+ before = a1+ between = a2+ after = a3+#else+ -- See https://github.com/haskell/bytestring/issues/212+ -- write -> read does not roundrip with GHC 7.2 and+ -- characters in the \xEF00-\xEFFF range.+ safeChr = \c -> c < '\xEF00' || c > '\xEFFF'+ before = filter safeChr a1+ between = filter safeChr a2+ after = filter safeChr a3+#endif+ (tempFile, tempH) <- openTempFile "." "test-builder.tmp"+ -- switch to UTF-8 encoding+ hSetEncoding tempH utf8+ hSetNewlineMode tempH noNewlineTranslation+ -- output recipe with intermediate direct writing to handle+ let b = fst $ recipeComponents recipe+ hPutStr tempH before+ hPutBuilder tempH b+ hPutStr tempH between+ hPutBuilder tempH b+ hPutStr tempH after+ hClose tempH+ -- read file+ lbs <- L.readFile tempFile+ _ <- evaluate (L.length $ lbs)+ removeFile tempFile+ -- compare to pure builder implementation+ let lbsRef = toLazyByteString $ fold+ [stringUtf8 before, b, stringUtf8 between, b, stringUtf8 after]+ -- report+ let msg = unlines+ [ "task: " ++ show args+ , "via file: " ++ show lbs+ , "direct : " ++ show lbsRef+ -- , "diff : " ++ show (dropWhile (uncurry (==)) $ zip x1 x2)+ ]+ success = lbs == lbsRef+ unless success (error msg)+ return success++testHandlePutBuilderChar8 :: TestTree+testHandlePutBuilderChar8 =+ testProperty "char8 hPutBuilder" testRecipe+ where+ testRecipe :: (String, String, String, Recipe) -> Property+ testRecipe args@(before, between, after, recipe) = ioProperty $ do+ (tempFile, tempH) <- openTempFile "." "TestBuilder"+ -- switch to binary / latin1 encoding+ hSetBinaryMode tempH True+ -- output recipe with intermediate direct writing to handle+ let b = fst $ recipeComponents recipe+ hPutStr tempH before+ hPutBuilder tempH b+ hPutStr tempH between+ hPutBuilder tempH b+ hPutStr tempH after+ hClose tempH+ -- read file+ lbs <- L.readFile tempFile+ _ <- evaluate (L.length $ lbs)+ removeFile tempFile+ -- compare to pure builder implementation+ let lbsRef = toLazyByteString $ fold+ [string8 before, b, string8 between, b, string8 after]+ -- report+ let msg = unlines+ [ "task: " ++ show args+ , "via file: " ++ show lbs+ , "direct : " ++ show lbsRef+ -- , "diff : " ++ show (dropWhile (uncurry (==)) $ zip x1 x2)+ ]+ success = lbs == lbsRef+ unless success (error msg)+ return success++removeFile :: String -> IO ()+removeFile fn = void $ withCString fn c_unlink++-- Recipes with which to test the builder functions+---------------------------------------------------++data Mode =+ Threshold Int+ | Insert+ | Copy+ | Smart+ | Hex+ deriving( Eq, Ord, Show )++data Action =+ SBS Mode S.ByteString+ | LBS Mode L.ByteString+ | ShBS Sh.ShortByteString+ | W8 Word8+ | W8S [Word8]+ | String String+ | FDec Float+ | DDec Double+ | Flush+ | EnsureFree Word+ | ModState Int+ deriving( Eq, Ord, Show )++data Strategy = Safe | Untrimmed+ deriving( Eq, Ord, Show )++data Recipe = Recipe Strategy Int Int L.ByteString [Action]+ deriving( Eq, Ord, Show )++renderRecipe :: Recipe -> [Word8]+renderRecipe (Recipe _ firstSize _ cont as) =+ D.toList $ evalState (execWriterT (traverse_ renderAction as)) firstSize+ `D.append` renderLBS cont+ where+ renderAction :: Monad m => Action -> WriterT (D.DList Word8) (StateT Int m) ()+ renderAction (SBS Hex bs) = tell $ foldMap hexWord8 $ S.unpack bs+ renderAction (SBS _ bs) = tell $ D.fromList $ S.unpack bs+ renderAction (LBS Hex lbs) = tell $ foldMap hexWord8 $ L.unpack lbs+ renderAction (LBS _ lbs) = tell $ renderLBS lbs+ renderAction (ShBS sbs) = tell $ D.fromList $ Sh.unpack sbs+ renderAction (W8 w) = tell $ return w+ renderAction (W8S ws) = tell $ D.fromList ws+ renderAction (String cs) = tell $ foldMap (D.fromList . charUtf8_list) cs+ renderAction Flush = tell $ D.empty+ renderAction (EnsureFree _) = tell $ D.empty+ renderAction (FDec f) = tell $ D.fromList $ encodeASCII $ show f+ renderAction (DDec d) = tell $ D.fromList $ encodeASCII $ show d+ renderAction (ModState i) = do+ s <- lift get+ tell (D.fromList $ encodeASCII $ show s)+ lift $ put (s - i)++ renderLBS = D.fromList . L.unpack+ hexWord8 = D.fromList . wordHexFixed_list++buildAction :: Action -> StateT Int Put ()+buildAction (SBS Hex bs) = lift $ putBuilder $ byteStringHex bs+buildAction (SBS Smart bs) = lift $ putBuilder $ byteString bs+buildAction (SBS Copy bs) = lift $ putBuilder $ byteStringCopy bs+buildAction (SBS Insert bs) = lift $ putBuilder $ byteStringInsert bs+buildAction (SBS (Threshold i) bs) = lift $ putBuilder $ byteStringThreshold i bs+buildAction (LBS Hex lbs) = lift $ putBuilder $ lazyByteStringHex lbs+buildAction (LBS Smart lbs) = lift $ putBuilder $ lazyByteString lbs+buildAction (LBS Copy lbs) = lift $ putBuilder $ lazyByteStringCopy lbs+buildAction (LBS Insert lbs) = lift $ putBuilder $ lazyByteStringInsert lbs+buildAction (LBS (Threshold i) lbs) = lift $ putBuilder $ lazyByteStringThreshold i lbs+buildAction (ShBS sbs) = lift $ putBuilder $ shortByteString sbs+buildAction (W8 w) = lift $ putBuilder $ word8 w+buildAction (W8S ws) = lift $ putBuilder $ BP.primMapListFixed BP.word8 ws+buildAction (String cs) = lift $ putBuilder $ stringUtf8 cs+buildAction (FDec f) = lift $ putBuilder $ floatDec f+buildAction (DDec d) = lift $ putBuilder $ doubleDec d+buildAction Flush = lift $ putBuilder $ flush+buildAction (EnsureFree minFree) = lift $ putBuilder $ ensureFree $ fromIntegral minFree+buildAction (ModState i) = do+ s <- get+ lift $ putBuilder $ intDec s+ put (s - i)++buildRecipe :: Recipe -> [Word8]+buildRecipe recipe =+ L.unpack $ toLBS b+ where+ (b, toLBS) = recipeComponents recipe+++recipeComponents :: Recipe -> (Builder, Builder -> L.ByteString)+recipeComponents (Recipe how firstSize otherSize cont as) =+ (b, toLBS)+ where+ toLBS = toLazyByteStringWith (strategy how firstSize otherSize) cont+ where+ strategy Safe = safeStrategy+ strategy Untrimmed = untrimmedStrategy++ b = fromPut $ evalStateT (traverse_ buildAction as) firstSize+++-- 'Arbitary' instances+-----------------------++instance Arbitrary L.ByteString where+ arbitrary = L.fromChunks <$> listOf arbitrary+ shrink lbs+ | L.null lbs = []+ | otherwise = pure $ L.take (L.length lbs `div` 2) lbs++instance Arbitrary S.ByteString where+ arbitrary =+ trim S.drop =<< trim S.take =<< S.pack <$> listOf arbitrary+ where+ trim f bs = oneof [pure bs, f <$> choose (0, S.length bs) <*> pure bs]++ shrink bs+ | S.null bs = []+ | otherwise = pure $ S.take (S.length bs `div` 2) bs++instance Arbitrary Mode where+ arbitrary = oneof+ [Threshold <$> arbitrary, pure Smart, pure Insert, pure Copy, pure Hex]++ shrink (Threshold i) = Threshold <$> shrink i+ shrink _ = []++instance Arbitrary Action where+ arbitrary = oneof+ [ SBS <$> arbitrary <*> arbitrary+ , LBS <$> arbitrary <*> arbitrary+ , ShBS . Sh.toShort <$> arbitrary+ , W8 <$> arbitrary+ , W8S <$> listOf arbitrary+ -- ensure that larger character codes are also tested+ , String . getUnicodeString <$> arbitrary+ , pure Flush+ -- never request more than 64kb free space+ , (EnsureFree . (`mod` 0xffff)) <$> arbitrary+ , FDec <$> arbitrary+ , DDec <$> arbitrary+ , ModState <$> arbitrary+ ]+ where++ shrink (SBS m bs) =+ (SBS <$> shrink m <*> pure bs) <|>+ (SBS <$> pure m <*> shrink bs)+ shrink (LBS m lbs) =+ (LBS <$> shrink m <*> pure lbs) <|>+ (LBS <$> pure m <*> shrink lbs)+ shrink (ShBS sbs) =+ ShBS . Sh.toShort <$> shrink (Sh.fromShort sbs)+ shrink (W8 w) = W8 <$> shrink w+ shrink (W8S ws) = W8S <$> shrink ws+ shrink (String cs) = String <$> shrink cs+ shrink Flush = []+ shrink (EnsureFree i) = EnsureFree <$> shrink i+ shrink (FDec f) = FDec <$> shrink f+ shrink (DDec d) = DDec <$> shrink d+ shrink (ModState i) = ModState <$> shrink i++instance Arbitrary Strategy where+ arbitrary = elements [Safe, Untrimmed]+ shrink _ = []++instance Arbitrary Recipe where+ arbitrary =+ Recipe <$> arbitrary+ <*> ((`mod` 33333) <$> arbitrary) -- bound max chunk-sizes+ <*> ((`mod` 33337) <$> arbitrary)+ <*> arbitrary+ <*> listOf arbitrary++ -- shrinking the actions first is desirable+ shrink (Recipe a b c d e) = asum+ [ (\x -> Recipe a b c d x) <$> shrink e+ , (\x -> Recipe a b c x e) <$> shrink d+ , (\x -> Recipe a b x d e) <$> shrink c+ , (\x -> Recipe a x c d e) <$> shrink b+ , (\x -> Recipe x b c d e) <$> shrink a+ ]+++------------------------------------------------------------------------------+-- Creating Builders from basic encodings+------------------------------------------------------------------------------++testsEncodingToBuilder :: [TestTree]+testsEncodingToBuilder =+ [ test_encodeUnfoldrF+ , test_encodeUnfoldrB+ ]+++-- Unfoldr fused with encoding+------------------------------++test_encodeUnfoldrF :: TestTree+test_encodeUnfoldrF =+ compareImpls "encodeUnfoldrF word8" id encode+ where+ toLBS = toLazyByteStringWith (safeStrategy 23 101) L.empty+ encode =+ L.unpack . toLBS . BP.primUnfoldrFixed BP.word8 go+ where+ go [] = Nothing+ go (w:ws) = Just (w, ws)+++test_encodeUnfoldrB :: TestTree+test_encodeUnfoldrB =+ compareImpls "encodeUnfoldrB charUtf8" (foldMap charUtf8_list) encode+ where+ toLBS = toLazyByteStringWith (safeStrategy 23 101) L.empty+ encode =+ L.unpack . toLBS . BP.primUnfoldrBounded BP.charUtf8 go+ where+ go [] = Nothing+ go (c:cs) = Just (c, cs)+++------------------------------------------------------------------------------+-- Testing the Put monad+------------------------------------------------------------------------------++testPut :: TestTree+testPut = testGroup "Put monad"+ [ testLaw "identity" (\v -> (pure id <*> putInt v) `eqPut` (putInt v))++ , testLaw "composition" $ \(u, v, w) ->+ (pure (.) <*> minusInt u <*> minusInt v <*> putInt w) `eqPut`+ (minusInt u <*> (minusInt v <*> putInt w))++ , testLaw "homomorphism" $ \(f, x) ->+ (pure (f -) <*> pure x) `eqPut` (pure (f - x))++ , testLaw "interchange" $ \(u, y) ->+ (minusInt u <*> pure y) `eqPut` (pure ($ y) <*> minusInt u)++ , testLaw "ignore left value" $ \(u, v) ->+ (putInt u *> putInt v) `eqPut` (pure (const id) <*> putInt u <*> putInt v)++ , testLaw "ignore right value" $ \(u, v) ->+ (putInt u <* putInt v) `eqPut` (pure const <*> putInt u <*> putInt v)++ , testLaw "functor" $ \(f, x) ->+ (fmap (f -) (putInt x)) `eqPut` (pure (f -) <*> putInt x)++ ]+ where+ putInt i = putBuilder (integerDec i) >> return i+ minusInt i = (-) <$> putInt i+ run p = toLazyByteString $ fromPut (do i <- p; _ <- putInt i; return ())+ eqPut p1 p2 = (run p1, run p2)++ testLaw name f = compareImpls name (fst . f) (snd . f)+++------------------------------------------------------------------------------+-- Testing the Driver <-> Builder protocol+------------------------------------------------------------------------------++-- | Ensure that there are at least 'n' free bytes for the following 'Builder'.+{-# INLINE ensureFree #-}+ensureFree :: Int -> Builder+ensureFree minFree =+ BI.builder step+ where+ step k br@(BI.BufferRange op ope)+ | ope `minusPtr` op < minFree = return $ BI.bufferFull minFree op next+ | otherwise = k br+ where+ next br'@(BI.BufferRange op' ope')+ | freeSpace < minFree =+ error $ "ensureFree: requested " ++ show minFree ++ " bytes, " +++ "but got only " ++ show freeSpace ++ " bytes"+ | otherwise = k br'+ where+ freeSpace = ope' `minusPtr` op'+++------------------------------------------------------------------------------+-- Testing the Builder runner+------------------------------------------------------------------------------++testRunBuilder :: TestTree+testRunBuilder =+ testProperty "runBuilder" prop+ where+ prop actions =+ ioProperty $ do+ let (builder, _) = recipeComponents recipe+ expected = renderRecipe recipe+ actual <- bufferWriterOutput (runBuilder builder)+ return (S.unpack actual == expected)+ where+ recipe = Recipe Safe 0 0 L.empty actions++bufferWriterOutput :: BufferWriter -> IO S.ByteString+bufferWriterOutput bwrite0 = do+ let len0 = 8+ buf <- S.mallocByteString len0+ bss <- go [] buf len0 bwrite0+ return (S.concat (reverse bss))+ where+ go :: [S.ByteString] -> ForeignPtr Word8 -> Int -> BufferWriter -> IO [S.ByteString]+ go bss !buf !len bwrite = do+ (wc, next) <- withForeignPtr buf $ \ptr -> bwrite ptr len+ bs <- getBuffer buf wc+ case next of+ Done -> return (bs:bss)+ More m bwrite' | m <= len -> go (bs:bss) buf len bwrite'+ | otherwise -> do let len' = m+ buf' <- S.mallocByteString len'+ go (bs:bss) buf' len' bwrite'+ Chunk c bwrite' -> go (c:bs:bss) buf len bwrite'++ getBuffer :: ForeignPtr Word8 -> Int -> IO S.ByteString+ getBuffer buf len = withForeignPtr buf $ \ptr ->+ S.packCStringLen (castPtr ptr, len)+++------------------------------------------------------------------------------+-- Testing the pre-defined builders+------------------------------------------------------------------------------++testBuilderConstr :: (Arbitrary a, Show a)+ => TestName -> (a -> [Word8]) -> (a -> Builder) -> TestTree+testBuilderConstr name ref mkBuilder =+ testProperty name check+ where+ check x =+ (ws ++ ws) ==+ (L.unpack $ toLazyByteString $ mkBuilder x `BI.append` mkBuilder x)+ where+ ws = ref x+++testsBinary :: [TestTree]+testsBinary =+ [ testBuilderConstr "word8" bigEndian_list word8+ , testBuilderConstr "int8" bigEndian_list int8++ -- big-endian+ , testBuilderConstr "int16BE" bigEndian_list int16BE+ , testBuilderConstr "int32BE" bigEndian_list int32BE+ , testBuilderConstr "int64BE" bigEndian_list int64BE++ , testBuilderConstr "word16BE" bigEndian_list word16BE+ , testBuilderConstr "word32BE" bigEndian_list word32BE+ , testBuilderConstr "word64BE" bigEndian_list word64BE++ , testBuilderConstr "floatLE" (float_list littleEndian_list) floatLE+ , testBuilderConstr "doubleLE" (double_list littleEndian_list) doubleLE++ -- little-endian+ , testBuilderConstr "int16LE" littleEndian_list int16LE+ , testBuilderConstr "int32LE" littleEndian_list int32LE+ , testBuilderConstr "int64LE" littleEndian_list int64LE++ , testBuilderConstr "word16LE" littleEndian_list word16LE+ , testBuilderConstr "word32LE" littleEndian_list word32LE+ , testBuilderConstr "word64LE" littleEndian_list word64LE++ , testBuilderConstr "floatBE" (float_list bigEndian_list) floatBE+ , testBuilderConstr "doubleBE" (double_list bigEndian_list) doubleBE++ -- host dependent+ , testBuilderConstr "int16Host" hostEndian_list int16Host+ , testBuilderConstr "int32Host" hostEndian_list int32Host+ , testBuilderConstr "int64Host" hostEndian_list int64Host+ , testBuilderConstr "intHost" hostEndian_list intHost++ , testBuilderConstr "word16Host" hostEndian_list word16Host+ , testBuilderConstr "word32Host" hostEndian_list word32Host+ , testBuilderConstr "word64Host" hostEndian_list word64Host+ , testBuilderConstr "wordHost" hostEndian_list wordHost++ , testBuilderConstr "floatHost" (float_list hostEndian_list) floatHost+ , testBuilderConstr "doubleHost" (double_list hostEndian_list) doubleHost+ ]++testsASCII :: [TestTree]+testsASCII =+ [ testBuilderConstr "char7" char7_list char7+ , testBuilderConstr "string7" (foldMap char7_list) string7++ , testBuilderConstr "int8Dec" dec_list int8Dec+ , testBuilderConstr "int16Dec" dec_list int16Dec+ , testBuilderConstr "int32Dec" dec_list int32Dec+ , testBuilderConstr "int64Dec" dec_list int64Dec+ , testBuilderConstr "intDec" dec_list intDec++ , testBuilderConstr "word8Dec" dec_list word8Dec+ , testBuilderConstr "word16Dec" dec_list word16Dec+ , testBuilderConstr "word32Dec" dec_list word32Dec+ , testBuilderConstr "word64Dec" dec_list word64Dec+ , testBuilderConstr "wordDec" dec_list wordDec++ , testBuilderConstr "integerDec" (dec_list . enlarge) (integerDec . enlarge)+ , testBuilderConstr "floatDec" dec_list floatDec+ , testBuilderConstr "doubleDec" dec_list doubleDec++ , testBuilderConstr "word8Hex" hex_list word8Hex+ , testBuilderConstr "word16Hex" hex_list word16Hex+ , testBuilderConstr "word32Hex" hex_list word32Hex+ , testBuilderConstr "word64Hex" hex_list word64Hex+ , testBuilderConstr "wordHex" hex_list wordHex++ , testBuilderConstr "word8HexFixed" wordHexFixed_list word8HexFixed+ , testBuilderConstr "word16HexFixed" wordHexFixed_list word16HexFixed+ , testBuilderConstr "word32HexFixed" wordHexFixed_list word32HexFixed+ , testBuilderConstr "word64HexFixed" wordHexFixed_list word64HexFixed++ , testBuilderConstr "int8HexFixed" int8HexFixed_list int8HexFixed+ , testBuilderConstr "int16HexFixed" int16HexFixed_list int16HexFixed+ , testBuilderConstr "int32HexFixed" int32HexFixed_list int32HexFixed+ , testBuilderConstr "int64HexFixed" int64HexFixed_list int64HexFixed++ , testBuilderConstr "floatHexFixed" floatHexFixed_list floatHexFixed+ , testBuilderConstr "doubleHexFixed" doubleHexFixed_list doubleHexFixed+ ]+ where+ enlarge (n, e) = n ^ (abs (e `mod` (50 :: Integer)))++testsChar8 :: [TestTree]+testsChar8 =+ [ testBuilderConstr "charChar8" char8_list char8+ , testBuilderConstr "stringChar8" (foldMap char8_list) string8+ ]++testsUtf8 :: [TestTree]+testsUtf8 =+ [ testBuilderConstr "charUtf8" charUtf8_list charUtf8+ , testBuilderConstr "stringUtf8" (foldMap charUtf8_list) stringUtf8+ ]
+ tests/builder/TestSuite.hs view
@@ -0,0 +1,17 @@+module Main where++import qualified Data.ByteString.Builder.Tests+import qualified Data.ByteString.Builder.Prim.Tests+import Test.Tasty (defaultMain, TestTree, testGroup)++main :: IO ()+main = defaultMain $ testGroup "All" tests++tests :: [TestTree]+tests =+ [ testGroup "Data.ByteString.Builder"+ Data.ByteString.Builder.Tests.tests++ , testGroup "Data.ByteString.Builder.BasicEncoding"+ Data.ByteString.Builder.Prim.Tests.tests+ ]