bytestring 0.10.10.1 → 0.10.12.0
raw patch · 29 files changed
+301/−4232 lines, 29 filesdep −HUnitdep −QuickCheckdep −byteorderdep ~basePVP ok
version bump matches the API change (PVP)
Dependencies removed: HUnit, QuickCheck, byteorder, directory, dlist, mtl, random, test-framework, test-framework-hunit, test-framework-quickcheck2
Dependency ranges changed: base
API changes (from Hackage documentation)
+ Data.ByteString: dropWhileEnd :: (Word8 -> Bool) -> ByteString -> ByteString
+ Data.ByteString: findIndexEnd :: (Word8 -> Bool) -> ByteString -> Maybe Int
+ Data.ByteString: takeWhileEnd :: (Word8 -> Bool) -> ByteString -> ByteString
+ Data.ByteString.Builder.Prim.Internal: boundedPrim :: Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
+ Data.ByteString.Char8: dropSpace :: ByteString -> ByteString
+ Data.ByteString.Char8: dropWhileEnd :: (Char -> Bool) -> ByteString -> ByteString
+ Data.ByteString.Char8: partition :: (Char -> Bool) -> ByteString -> (ByteString, ByteString)
+ Data.ByteString.Char8: strip :: ByteString -> ByteString
+ Data.ByteString.Char8: takeWhileEnd :: (Char -> Bool) -> ByteString -> ByteString
+ Data.ByteString.Internal: createUptoN' :: Int -> (Ptr Word8 -> IO (Int, a)) -> IO (ByteString, a)
+ Data.ByteString.Internal: instance GHC.Exts.IsList Data.ByteString.Internal.ByteString
+ Data.ByteString.Internal: unsafeCreateUptoN' :: Int -> (Ptr Word8 -> IO (Int, a)) -> (ByteString, a)
+ Data.ByteString.Lazy: findIndexEnd :: (Word8 -> Bool) -> ByteString -> Maybe Int64
+ Data.ByteString.Lazy.Char8: partition :: (Char -> Bool) -> ByteString -> (ByteString, ByteString)
+ Data.ByteString.Lazy.Internal: instance GHC.Exts.IsList Data.ByteString.Lazy.Internal.ByteString
+ Data.ByteString.Short.Internal: instance GHC.Exts.IsList Data.ByteString.Short.Internal.ShortByteString
Files
- Changelog.md +17/−0
- Data/ByteString.hs +46/−19
- Data/ByteString/Builder.hs +8/−7
- Data/ByteString/Builder/Extra.hs +1/−1
- Data/ByteString/Builder/Internal.hs +11/−9
- Data/ByteString/Builder/Prim.hs +22/−28
- Data/ByteString/Builder/Prim/ASCII.hs +6/−6
- Data/ByteString/Builder/Prim/Internal.hs +14/−6
- Data/ByteString/Char8.hs +39/−4
- Data/ByteString/Internal.hs +33/−11
- Data/ByteString/Lazy.hs +29/−18
- Data/ByteString/Lazy/Builder.hs +3/−3
- Data/ByteString/Lazy/Builder/ASCII.hs +5/−3
- Data/ByteString/Lazy/Builder/Extras.hs +3/−3
- Data/ByteString/Lazy/Char8.hs +19/−12
- Data/ByteString/Lazy/Internal.hs +16/−1
- Data/ByteString/Short.hs +9/−9
- Data/ByteString/Short/Internal.hs +13/−2
- Data/ByteString/Unsafe.hs +6/−5
- bytestring.cabal +1/−109
- tests/Properties.hs +0/−2443
- tests/QuickCheckUtils.hs +0/−204
- tests/Regressions.hs +0/−25
- tests/Rules.hs +0/−48
- tests/TestFramework.hs +0/−70
- tests/builder/Data/ByteString/Builder/Prim/TestUtils.hs +0/−377
- tests/builder/Data/ByteString/Builder/Prim/Tests.hs +0/−168
- tests/builder/Data/ByteString/Builder/Tests.hs +0/−619
- tests/builder/TestSuite.hs +0/−22
Changelog.md view
@@ -1,3 +1,20 @@+[0.10.12.0] – August 2020++ * **Note:** There are several breaking changes planned to be included in v0.11.+ Please ensure that your packages have appropriate upper bounds on bytestring,+ in order to minimize avoidable breakage.+ * [Add `takeWhileEnd` and `dropWhileEnd` to `Data.ByteString` and `Data.ByteString.Char8`, and add `dropSpace` and `strip` to `Data.ByteString.Char8`](https://github.com/haskell/bytestring/pull/121)+ * [Add `findIndexEnd` to `Data.ByteString` and `Data.ByteString.Lazy`](https://github.com/haskell/bytestring/pull/155)+ * [Add `partition` to `Data.ByteString.Char8` and `Data.ByteString.Lazy.Char8`](https://github.com/haskell/bytestring/pull/251)+ * [Add `IsList` instances for strict and lazy `ByteString` and for `ShortByteString`](https://github.com/haskell/bytestring/pull/219)+ * [Add `createUpToN'` and `unsafeCreateUpToN'` to `Data.ByteString.Internal`](https://github.com/haskell/bytestring/pull/245)+ * [Add `boundedPrim` to `Data.ByteString.Builder.Prim.Internal` and deprecate `boudedPrim`](https://github.com/haskell/bytestring/pull/246)+ * [Deprecate the `Data.ByteString.Lazy.Builder` and `Data.ByteString.Lazy.Builder.{ASCII,Extras}` modules](https://github.com/haskell/bytestring/pull/250)+ * [Fix documented complexity of `Data.ByteString.Lazy.length`](https://github.com/haskell/bytestring/pull/255)+ * [Assorted documentation fixes](https://github.com/haskell/bytestring/pull/248)++[0.10.12.0]: https://github.com/haskell/bytestring/compare/0.10.10.1...0.10.12.0+ 0.10.10.1 – June 2020 * Fix off-by-one infinite loop in primMapByteStringBounded ([#203])
Data/ByteString.hs view
@@ -113,7 +113,9 @@ drop, -- :: Int -> ByteString -> ByteString splitAt, -- :: Int -> ByteString -> (ByteString, ByteString) takeWhile, -- :: (Word8 -> Bool) -> ByteString -> ByteString+ takeWhileEnd, -- :: (Word8 -> Bool) -> ByteString -> ByteString dropWhile, -- :: (Word8 -> Bool) -> ByteString -> ByteString+ dropWhileEnd, -- :: (Word8 -> Bool) -> ByteString -> ByteString span, -- :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString) spanEnd, -- :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString) break, -- :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)@@ -157,6 +159,7 @@ elemIndexEnd, -- :: Word8 -> ByteString -> Maybe Int findIndex, -- :: (Word8 -> Bool) -> ByteString -> Maybe Int findIndices, -- :: (Word8 -> Bool) -> ByteString -> [Int]+ findIndexEnd, -- :: (Word8 -> Bool) -> ByteString -> Maybe Int count, -- :: Word8 -> ByteString -> Int -- * Zipping and unzipping ByteStrings@@ -540,7 +543,7 @@ {-# INLINE foldr' #-} -- | 'foldl1' is a variant of 'foldl' that has no starting value--- argument, and thus must be applied to non-empty 'ByteStrings'.+-- 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@@ -835,11 +838,27 @@ takeWhile f ps = unsafeTake (findIndexOrEnd (not . f) ps) ps {-# INLINE takeWhile #-} +-- | 'takeWhileEnd', applied to a predicate @p@ and a ByteString @xs@, returns+-- the longest suffix (possibly empty) of @xs@ of elements that satisfy @p@.+--+-- @since 0.10.12.0+takeWhileEnd :: (Word8 -> Bool) -> ByteString -> ByteString+takeWhileEnd f ps = unsafeDrop (findFromEndUntil (not . f) ps) ps+{-# INLINE takeWhileEnd #-}+ -- | 'dropWhile' @p xs@ returns the suffix remaining after 'takeWhile' @p xs@. dropWhile :: (Word8 -> Bool) -> ByteString -> ByteString dropWhile f ps = unsafeDrop (findIndexOrEnd (not . f) ps) ps {-# INLINE dropWhile #-} +-- | 'dropWhileEnd' @p xs@ returns the prefix remaining after 'takeWhileEnd' @p+-- xs@.+--+-- @since 0.10.12.0+dropWhileEnd :: (Word8 -> Bool) -> ByteString -> ByteString+dropWhileEnd f ps = unsafeTake (findFromEndUntil (not . f) ps) ps+{-# INLINE dropWhileEnd #-}+ -- instead of findIndexOrEnd, we could use memchr here. -- | 'break' @p@ is equivalent to @'span' ('not' . p)@.@@ -877,7 +896,7 @@ -- of the specified byte. It is more efficient than 'break' as it is -- implemented with @memchr(3)@. I.e. ----- > break (=='c') "abcd" == breakByte 'c' "abcd"+-- > break (==99) "abcd" == breakByte 99 "abcd" -- fromEnum 'c' == 99 -- breakByte :: Word8 -> ByteString -> (ByteString, ByteString) breakByte c p = case elemIndex c p of@@ -902,7 +921,7 @@ -- occurence of a byte other than its argument. It is more efficient -- than 'span (==)' ----- > span (=='c') "abcd" == spanByte 'c' "abcd"+-- > span (==99) "abcd" == spanByte 99 "abcd" -- fromEnum 'c' == 99 -- spanByte :: Word8 -> ByteString -> (ByteString, ByteString) spanByte c ps@(PS x s l) =@@ -953,8 +972,8 @@ -- The resulting components do not contain the separators. Two adjacent -- separators result in an empty component in the output. eg. ----- > splitWith (=='a') "aabbaca" == ["","","bb","c",""]--- > splitWith (=='a') [] == []+-- > splitWith (==97) "aabbaca" == ["","","bb","c",""] -- fromEnum 'a' == 97+-- > splitWith (==97) [] == [] -- splitWith :: (Word8 -> Bool) -> ByteString -> [ByteString] splitWith _pred (PS _ _ 0) = []@@ -985,9 +1004,9 @@ -- | /O(n)/ Break a 'ByteString' into pieces separated by the byte -- argument, consuming the delimiter. I.e. ----- > split '\n' "a\nb\nd\ne" == ["a","b","d","e"]--- > split 'a' "aXaXaXa" == ["","X","X","X",""]--- > split 'x' "x" == ["",""]+-- > split 10 "a\nb\nd\ne" == ["a","b","d","e"] -- fromEnum '\n' == 10+-- > split 97 "aXaXaXa" == ["","X","X","X",""] -- fromEnum 'a' == 97+-- > split 120 "x" == ["",""] -- fromEnum 'x' == 120 -- -- and --@@ -995,7 +1014,7 @@ -- > split == splitWith . (==) -- -- As for all splitting functions in this library, this function does--- not copy the substrings, it just constructs new 'ByteStrings' that+-- not copy the substrings, it just constructs new 'ByteString's that -- are slices of the original. -- split :: Word8 -> ByteString -> [ByteString]@@ -1098,14 +1117,7 @@ -- > (-) (length xs - 1) `fmap` elemIndex c (reverse xs) -- elemIndexEnd :: Word8 -> ByteString -> Maybe Int-elemIndexEnd ch (PS x s l) = accursedUnutterablePerformIO $ withForeignPtr x $ \p ->- go (p `plusPtr` s) (l-1)- where- go !p !i | i < 0 = return Nothing- | otherwise = do ch' <- peekByteOff p i- if ch == ch'- then return $ Just i- else go p (i-1)+elemIndexEnd = findIndexEnd . (==) {-# INLINE elemIndexEnd #-} -- | /O(n)/ The 'elemIndices' function extends 'elemIndex', by returning@@ -1134,7 +1146,7 @@ fmap fromIntegral $ c_count (p `plusPtr` s) (fromIntegral m) w {-# INLINE count #-} --- | The 'findIndex' function takes a predicate and a 'ByteString' and+-- | /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@@ -1147,7 +1159,22 @@ else go (ptr `plusPtr` 1) (n+1) {-# INLINE findIndex #-} --- | The 'findIndices' function extends 'findIndex', by returning the+-- | /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.10.12.0+findIndexEnd :: (Word8 -> Bool) -> ByteString -> Maybe Int+findIndexEnd k (PS x s l) = accursedUnutterablePerformIO $ withForeignPtr x $ \ f -> go (f `plusPtr` s) (l-1)+ 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)+{-# 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
Data/ByteString/Builder.hs view
@@ -67,12 +67,12 @@ @ CSV is a character-based representation of tables. For maximal modularity,-we could first render 'Table's as 'String's and then encode this 'String'+we could first render @Table@s as 'String's and then encode this 'String' using some Unicode character encoding. However, this sacrifices performance due to the intermediate 'String' representation being built and thrown away right afterwards. We get rid of this intermediate 'String' representation by fixing the character encoding to UTF-8 and using 'Builder's to convert-'Table's directly to UTF-8 encoded CSV tables represented as lazy+@Table@s directly to UTF-8 encoded CSV tables represented as lazy 'L.ByteString's. @@@ -105,10 +105,10 @@ Using 'intDec' is more efficient than @'stringUtf8' . 'show'@, as it avoids constructing an intermediate 'String'. Avoiding this intermediate data structure significantly improves- performance because encoding 'Cell's is the core operation+ performance because encoding @Cell@s is the core operation for rendering CSV-tables. See "Data.ByteString.Builder.Prim" for further- information on how to improve the performance of 'renderString'.+ information on how to improve the performance of @renderString@. We demonstrate our UTF-8 CSV encoding function on the following table. @@ -149,14 +149,14 @@ we see that we took care to avoid intermediate data structures, as otherwise we would sacrifice performance. For example,- the following (arguably simpler) definition of 'renderRow' is about 20% slower.+ the following (arguably simpler) definition of @renderRow@ is about 20% slower. >renderRow :: Row -> Builder >renderRow = mconcat . intersperse (charUtf8 ',') . map renderCell Similarly, using /O(n)/ concatentations like '++' or the equivalent 'S.concat' operations on strict and lazy 'L.ByteString's should be avoided.-The following definition of 'renderString' is also about 20% slower.+The following definition of @renderString@ is also about 20% slower. >renderString :: String -> Builder >renderString cs = charUtf8 $ "\"" ++ concatMap escape cs ++ "\""@@ -291,7 +291,8 @@ -- enough buffer. -- -- It is recommended that the 'Handle' is set to binary and--- 'BlockBuffering' mode. See 'hSetBinaryMode' and 'hSetBuffering'.+-- 'System.IO.BlockBuffering' mode. See 'System.IO.hSetBinaryMode' and+-- 'System.IO.hSetBuffering'. -- -- This function is more efficient than @hPut . 'toLazyByteString'@ because in -- many cases no buffer allocation has to be done. Moreover, the results of
Data/ByteString/Builder/Extra.hs view
@@ -81,7 +81,7 @@ -- * an IO action for writing the Builder's data into a user-supplied memory -- buffer. ----- * a pre-existing chunks of data represented by a strict 'ByteString'+-- * a pre-existing chunks of data represented by a strict 'S.ByteString' -- -- While this is rather low level, it provides you with full flexibility in -- how the data is written out.
Data/ByteString/Builder/Internal.hs view
@@ -443,7 +443,8 @@ -- -- 'Put's are a generalization of 'Builder's. The typical use case is the -- implementation of an encoding that might fail (e.g., an interface to the--- 'zlib' compression library or the conversion from Base64 encoded data to+-- <https://hackage.haskell.org/package/zlib zlib>+-- compression library or the conversion from Base64 encoded data to -- 8-bit data). For a 'Builder', the only way to handle and report such a -- failure is ignore it or call 'error'. In contrast, 'Put' actions are -- expressive enough to allow reportng and handling such a failure in a pure@@ -705,7 +706,7 @@ updateBufR op' return $ fillHandle minSize nextStep -- 'fillHandle' will flush the buffer (provided there is- -- really less than 'minSize' space left) before executing+ -- really less than @minSize@ space left) before executing -- the 'nextStep'. insertChunkH op' bs nextStep = do@@ -809,7 +810,8 @@ -- Raw memory ------------- --- | Ensure that there are at least 'n' free bytes for the following 'Builder'.+-- | @'ensureFree' n@ ensures that there are at least @n@ free bytes+-- for the following 'Builder'. {-# INLINE ensureFree #-} ensureFree :: Int -> Builder ensureFree minFree =@@ -1013,9 +1015,9 @@ :: (Maybe (Buffer, Int) -> IO Buffer) -- ^ Buffer allocation function. If 'Nothing' is given, then a new first -- buffer should be allocated. If @'Just' (oldBuf, minSize)@ is given,- -- then a buffer with minimal size 'minSize' must be returned. The- -- strategy may reuse the 'oldBuffer', if it can guarantee that this- -- referentially transparent and 'oldBuffer' is large enough.+ -- then a buffer with minimal size @minSize@ must be returned. The+ -- strategy may reuse the @oldBuf@, if it can guarantee that this+ -- referentially transparent and @oldBuf@ is large enough. -> Int -- ^ Default buffer size. -> (Int -> Int -> Bool)@@ -1067,7 +1069,7 @@ -- -- This function is inlined despite its heavy code-size to allow fusing with -- the allocation strategy. For example, the default 'Builder' execution--- function 'toLazyByteString' is defined as follows.+-- function 'Data.ByteString.Builder.toLazyByteString' is defined as follows. -- -- @ -- {-\# NOINLINE toLazyByteString \#-}@@ -1077,8 +1079,8 @@ -- -- where @L.empty@ is the zero-length lazy 'L.ByteString'. ----- In most cases, the parameters used by 'toLazyByteString' give good--- performance. A sub-performing case of 'toLazyByteString' is executing short+-- In most cases, the parameters used by 'Data.ByteString.Builder.toLazyByteString' give good+-- performance. A sub-performing case of 'Data.ByteString.Builder.toLazyByteString' is executing short -- (<128 bytes) 'Builder's. In this case, the allocation overhead for the first -- 4kb buffer and the trimming cost dominate the cost of executing the -- 'Builder'. You can avoid this problem using
Data/ByteString/Builder/Prim.hs view
@@ -100,24 +100,24 @@ renderString :: String -\> Builder renderString cs =- B.charUtf8 \'\"\' \<\> E.'encodeListWithB' escape cs \<\> B.charUtf8 \'\"\'+ B.charUtf8 \'\"\' \<\> 'P.primMapListBounded' escape cs \<\> B.charUtf8 \'\"\' where- escape :: E.'BoundedPrim' Char+ escape :: 'P.BoundedPrim' Char escape = 'condB' (== \'\\\\\') (fixed2 (\'\\\\\', \'\\\\\')) $ 'condB' (== \'\\\"\') (fixed2 (\'\\\\\', \'\\\"\')) $- E.'charUtf8'+ 'charUtf8'   {-\# INLINE fixed2 \#-}- fixed2 x = 'liftFixedToBounded' $ const x '>$<' E.'char7' '>*<' E.'char7'+ fixed2 x = 'P.liftFixedToBounded' $ const x '>$<' 'P.char7' '>*<' 'P.char7' @ The code should be mostly self-explanatory. The slightly awkward syntax is because the combinators are written such that the size-bound of the resulting 'BoundedPrim' can be computed at compile time. We also explicitly inline the-'fixed2' primitive, which encodes a fixed tuple of characters, to ensure that+@fixed2@ primitive, which encodes a fixed tuple of characters, to ensure that the bound computation happens at compile time. When encoding the following list-of 'String's, the optimized implementation of 'renderString' is two times+of 'String's, the optimized implementation of @renderString@ is two times faster. @@@ -140,23 +140,23 @@ @ {-\# INLINE charUtf8HtmlEscaped \#-}-charUtf8HtmlEscaped :: E.BoundedPrim Char+charUtf8HtmlEscaped :: 'BoundedPrim' Char charUtf8HtmlEscaped =- 'condB' (> \'\>\' ) E.'charUtf8' $+ 'condB' (> \'\>\' ) 'charUtf8' $ 'condB' (== \'\<\' ) (fixed4 (\'&\',(\'l\',(\'t\',\';\')))) $ -- < 'condB' (== \'\>\' ) (fixed4 (\'&\',(\'g\',(\'t\',\';\')))) $ -- > 'condB' (== \'&\' ) (fixed5 (\'&\',(\'a\',(\'m\',(\'p\',\';\'))))) $ -- & 'condB' (== \'\"\' ) (fixed5 (\'&\',(\'\#\',(\'3\',(\'4\',\';\'))))) $ -- &\#34; 'condB' (== \'\\\'\') (fixed5 (\'&\',(\'\#\',(\'3\',(\'9\',\';\'))))) $ -- &\#39;- ('liftFixedToBounded' E.'char7') -- fallback for 'Char's smaller than \'\>\'+ ('liftFixedToBounded' 'char7') -- fallback for 'Char's smaller than \'\>\' where {-\# INLINE fixed4 \#-} fixed4 x = 'liftFixedToBounded' $ const x '>$<'- E.char7 '>*<' E.char7 '>*<' E.char7 '>*<' E.char7+ char7 '>*<' char7 '>*<' char7 '>*<' char7   {-\# INLINE fixed5 \#-} fixed5 x = 'liftFixedToBounded' $ const x '>$<'- E.char7 '>*<' E.char7 '>*<' E.char7 '>*<' E.char7 '>*<' E.char7+ char7 '>*<' char7 '>*<' char7 '>*<' char7 '>*<' char7 @ This module currently does not expose functions that require the special@@ -301,7 +301,7 @@ -- > -- > renderString :: String -> Builder -- > renderString cs =--- > charUtf8 '"' <> encodeListWithB escapedUtf8 cs <> charUtf8 '"'+-- > charUtf8 '"' <> primMapListBounded escapedUtf8 cs <> charUtf8 '"' -- > where -- > escapedUtf8 :: BoundedPrim Char -- > escapedUtf8 =@@ -377,7 +377,8 @@ , FixedPrim -- ** Combinators- -- | The combinators for 'FixedPrim's are implemented such that the 'size'+ -- | The combinators for 'FixedPrim's are implemented such that the+ -- 'Data.ByteString.Builder.Prim.size' -- of the resulting 'FixedPrim' is computed at compile time. -- -- The '(>*<)' and '(>$<)' pairing and mapping operators can be used@@ -390,7 +391,7 @@ -- for constructing 'Builder's from 'FixedPrim's. The fused variants of -- this function are provided because they allow for more efficient -- implementations. Our compilers are just not smart enough yet; and for some- -- of the employed optimizations (see the code of 'encodeByteStringWithF')+ -- of the employed optimizations (see the code of 'primMapByteStringFixed') -- they will very likely never be. -- -- Note that functions marked with \"/Heavy inlining./\" are forced to be@@ -398,12 +399,12 @@ -- but are rather heavy in terms of code size. We recommend to define a -- top-level function for every concrete instantiation of such a function in -- order to share its code. A typical example is the function- -- 'byteStringHex' from "Data.ByteString.Builder.ASCII", which is- -- implemented as follows.+ -- 'Data.ByteString.Builder.byteStringHex' from "Data.ByteString.Builder.ASCII",+ -- which is implemented as follows. -- -- @ -- byteStringHex :: S.ByteString -> Builder- -- byteStringHex = 'encodeByteStringWithF' 'word8HexFixed'+ -- byteStringHex = 'primMapByteStringFixed' 'word8HexFixed' -- @ -- , primFixed@@ -505,10 +506,10 @@ -- copying it to the buffer to be filled. -- -- > mapToBuilder :: (Word8 -> Word8) -> S.ByteString -> Builder--- > mapToBuilder f = encodeByteStringWithF (contramapF f word8)+-- > mapToBuilder f = primMapByteStringFixed (contramapF f word8) -- -- We can also use it to hex-encode a strict 'S.ByteString' as shown by the--- 'byteStringHex' example above.+-- 'Data.ByteString.Builder.ASCII.byteStringHex' example above. {-# INLINE primMapByteStringFixed #-} primMapByteStringFixed :: FixedPrim Word8 -> (S.ByteString -> Builder) primMapByteStringFixed = primMapByteStringBounded . toB@@ -575,13 +576,7 @@ -- TODO: The same rules for 'putBuilder (..) >> putBuilder (..)' -- | Create a 'Builder' that encodes a list of values consecutively using a--- 'BoundedPrim' for each element. This function is more efficient than the--- canonical------ > filter p =--- > B.toLazyByteString .--- > E.encodeLazyByteStringWithF (E.ifF p E.word8) E.emptyF)--- >+-- 'BoundedPrim' for each element. This function is more efficient than -- -- > mconcat . map (primBounded w) --@@ -694,7 +689,7 @@ -- | UTF-8 encode a 'Char'. {-# INLINE charUtf8 #-} charUtf8 :: BoundedPrim Char-charUtf8 = boudedPrim 4 (encodeCharUtf8 f1 f2 f3 f4)+charUtf8 = boundedPrim 4 (encodeCharUtf8 f1 f2 f3 f4) where pokeN n io op = io op >> return (op `plusPtr` n) @@ -741,5 +736,4 @@ x3 = fromIntegral $ ((x `shiftR` 6) .&. 0x3F) + 0x80 x4 = fromIntegral $ (x .&. 0x3F) + 0x80 in f4 x1 x2 x3 x4-
Data/ByteString/Builder/Prim/ASCII.hs view
@@ -112,7 +112,7 @@ {-# INLINE encodeIntDecimal #-} encodeIntDecimal :: Integral a => Int -> BoundedPrim a-encodeIntDecimal bound = boudedPrim bound $ c_int_dec . fromIntegral+encodeIntDecimal bound = boundedPrim bound $ c_int_dec . fromIntegral -- | Decimal encoding of an 'Int8'. {-# INLINE int8Dec #-}@@ -133,7 +133,7 @@ -- | Decimal encoding of an 'Int64'. {-# INLINE int64Dec #-} int64Dec :: BoundedPrim Int64-int64Dec = boudedPrim 20 $ c_long_long_int_dec . fromIntegral+int64Dec = boundedPrim 20 $ c_long_long_int_dec . fromIntegral -- | Decimal encoding of an 'Int'. {-# INLINE intDec #-}@@ -154,7 +154,7 @@ {-# INLINE encodeWordDecimal #-} encodeWordDecimal :: Integral a => Int -> BoundedPrim a-encodeWordDecimal bound = boudedPrim bound $ c_uint_dec . fromIntegral+encodeWordDecimal bound = boundedPrim bound $ c_uint_dec . fromIntegral -- | Decimal encoding of a 'Word8'. {-# INLINE word8Dec #-}@@ -174,7 +174,7 @@ -- | Decimal encoding of a 'Word64'. {-# INLINE word64Dec #-} word64Dec :: BoundedPrim Word64-word64Dec = boudedPrim 20 $ c_long_long_uint_dec . fromIntegral+word64Dec = boundedPrim 20 $ c_long_long_uint_dec . fromIntegral -- | Decimal encoding of a 'Word'. {-# INLINE wordDec #-}@@ -199,7 +199,7 @@ {-# INLINE encodeWordHex #-} encodeWordHex :: forall a. (Storable a, Integral a) => BoundedPrim a encodeWordHex =- boudedPrim (2 * sizeOf (undefined :: a)) $ c_uint_hex . fromIntegral+ boundedPrim (2 * sizeOf (undefined :: a)) $ c_uint_hex . fromIntegral -- | Hexadecimal encoding of a 'Word8'. {-# INLINE word8Hex #-}@@ -219,7 +219,7 @@ -- | Hexadecimal encoding of a 'Word64'. {-# INLINE word64Hex #-} word64Hex :: BoundedPrim Word64-word64Hex = boudedPrim 16 $ c_long_long_uint_hex . fromIntegral+word64Hex = boundedPrim 16 $ c_long_long_uint_hex . fromIntegral -- | Hexadecimal encoding of a 'Word'. {-# INLINE wordHex #-}
Data/ByteString/Builder/Prim/Internal.hs view
@@ -20,7 +20,7 @@ -- standard encodings of standard Haskell values. -- -- If you need to write your own builder primitives, then be aware that you are--- writing code with /all saftey belts off/; i.e.,+-- writing code with /all safety belts off/; i.e., -- *this is the code that might make your application vulnerable to buffer-overflow attacks!* -- The "Data.ByteString.Builder.Prim.Tests" module provides you with -- utilities for testing your encodings thoroughly.@@ -42,7 +42,7 @@ -- * Bounded-size builder primitives , BoundedPrim- , boudedPrim+ , boundedPrim , sizeBound , runB @@ -64,6 +64,8 @@ , (>$<) , (>*<) + -- * Deprecated+ , boudedPrim ) where import Foreign@@ -93,9 +95,10 @@ -- We can use it for example to prepend and/or append fixed values to an -- primitive. --+-- > import Data.ByteString.Builder.Prim as P -- >showEncoding ((\x -> ('\'', (x, '\''))) >$< fixed3) 'x' = "'x'" -- > where--- > fixed3 = char7 >*< char7 >*< char7+-- > fixed3 = P.char7 >*< P.char7 >*< P.char7 -- -- Note that the rather verbose syntax for composition stems from the -- requirement to be able to compute the size / size bound at compile time.@@ -176,7 +179,7 @@ -- | Change a primitives such that it first applies a function to the value -- to be encoded. ----- Note that primitives are 'Contrafunctors'+-- Note that primitives are 'Contravariant' -- <http://hackage.haskell.org/package/contravariant>. Hence, the following -- laws hold. --@@ -231,6 +234,11 @@ sizeBound :: BoundedPrim a -> Int sizeBound (BP b _) = b +-- | @since 0.10.12.0+boundedPrim :: Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a+boundedPrim = BP++{-# DEPRECATED boudedPrim "Use 'boundedPrim' instead" #-} boudedPrim :: Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a boudedPrim = BP @@ -241,7 +249,7 @@ -- | Change a 'BoundedPrim' such that it first applies a function to the -- value to be encoded. ----- Note that 'BoundedPrim's are 'Contrafunctors'+-- Note that 'BoundedPrim's are 'Contravariant' -- <http://hackage.haskell.org/package/contravariant>. Hence, the following -- laws hold. --@@ -284,7 +292,7 @@ -- Unicode codepoints above 127 as follows. -- -- @---charASCIIDrop = 'condB' (< \'\\128\') ('fromF' 'char7') 'emptyB'+--charASCIIDrop = 'condB' (< \'\\128\') ('liftFixedToBounded' 'Data.ByteString.Builder.Prim.char7') 'emptyB' -- @ {-# INLINE CONLIKE condB #-} condB :: (a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
Data/ByteString/Char8.hs view
@@ -115,7 +115,10 @@ drop, -- :: Int -> ByteString -> ByteString splitAt, -- :: Int -> ByteString -> (ByteString, ByteString) takeWhile, -- :: (Char -> Bool) -> ByteString -> ByteString+ takeWhileEnd, -- :: (Char -> Bool) -> ByteString -> ByteString dropWhile, -- :: (Char -> Bool) -> ByteString -> ByteString+ dropWhileEnd, -- :: (Char -> Bool) -> ByteString -> ByteString+ dropSpace, -- :: ByteString -> ByteString span, -- :: (Char -> Bool) -> ByteString -> (ByteString, ByteString) spanEnd, -- :: (Char -> Bool) -> ByteString -> (ByteString, ByteString) break, -- :: (Char -> Bool) -> ByteString -> (ByteString, ByteString)@@ -124,6 +127,7 @@ groupBy, -- :: (Char -> Char -> Bool) -> ByteString -> [ByteString] inits, -- :: ByteString -> [ByteString] tails, -- :: ByteString -> [ByteString]+ strip, -- :: ByteString -> ByteString stripPrefix, -- :: ByteString -> ByteString -> Maybe ByteString stripSuffix, -- :: ByteString -> ByteString -> Maybe ByteString @@ -156,7 +160,7 @@ -- ** Searching with a predicate find, -- :: (Char -> Bool) -> ByteString -> Maybe Char filter, -- :: (Char -> Bool) -> ByteString -> ByteString--- partition -- :: (Char -> Bool) -> ByteString -> (ByteString, ByteString)+ partition, -- :: (Char -> Bool) -> ByteString -> (ByteString, ByteString) -- * Indexing ByteStrings index, -- :: ByteString -> Int -> Char@@ -366,7 +370,7 @@ {-# INLINE foldr' #-} -- | 'foldl1' is a variant of 'foldl' that has no starting value--- argument, and thus must be applied to non-empty 'ByteStrings'.+-- argument, and thus must be applied to non-empty 'ByteString's. foldl1 :: (Char -> Char -> Char) -> ByteString -> Char foldl1 f ps = w2c (B.foldl1 (\x y -> c2w (f (w2c x) (w2c y))) ps) {-# INLINE foldl1 #-}@@ -497,6 +501,15 @@ takeWhile f = B.takeWhile (f . w2c) {-# INLINE takeWhile #-} +-- | 'takeWhileEnd', applied to a predicate @p@ and a ByteString @xs@,+-- returns the longest suffix (possibly empty) of @xs@ of elements that+-- satisfy @p@.+--+-- @since 0.10.12.0+takeWhileEnd :: (Char -> Bool) -> ByteString -> ByteString+takeWhileEnd f = B.takeWhileEnd (f . w2c)+{-# INLINE takeWhileEnd #-}+ -- | 'dropWhile' @p xs@ returns the suffix remaining after 'takeWhile' @p xs@. dropWhile :: (Char -> Bool) -> ByteString -> ByteString dropWhile f = B.dropWhile (f . w2c)@@ -507,6 +520,14 @@ dropWhile isSpace = dropSpace #-} +-- | 'dropWhile' @p xs@ returns the prefix remaining after 'takeWhileEnd' @p+-- xs@.+--+-- @since 0.10.12.0+dropWhileEnd :: (Char -> Bool) -> ByteString -> ByteString+dropWhileEnd f = B.dropWhileEnd (f . w2c)+{-# INLINE dropWhileEnd #-}+ -- | 'break' @p@ is equivalent to @'span' ('not' . p)@. break :: (Char -> Bool) -> ByteString -> (ByteString, ByteString) break f = B.break (f . w2c)@@ -584,7 +605,7 @@ -- > split == splitWith . (==) -- -- As for all splitting functions in this library, this function does--- not copy the substrings, it just constructs new 'ByteStrings' that+-- not copy the substrings, it just constructs new 'ByteString's that -- are slices of the original. -- split :: Char -> ByteString -> [ByteString]@@ -689,6 +710,11 @@ filter f = B.filter (f . w2c) {-# INLINE filter #-} +-- | @since 0.10.12.0+partition :: (Char -> Bool) -> ByteString -> (ByteString, ByteString)+partition f = B.partition (f . w2c)+{-# INLINE partition #-}+ {- -- | /O(n)/ and /O(n\/c) space/ A first order equivalent of /filter . -- (==)/, for the common case of filtering a single Char. It is more@@ -812,6 +838,7 @@ -- -- > dropWhile isSpace == dropSpace --+-- @since 0.10.12.0 dropSpace :: ByteString -> ByteString dropSpace (PS x s l) = accursedUnutterablePerformIO $ withForeignPtr x $ \p -> do i <- firstnonspace (p `plusPtr` s) 0 l@@ -824,6 +851,12 @@ | otherwise = do w <- peekElemOff ptr n if isSpaceWord8 w then firstnonspace ptr (n+1) m else return n +-- | Remove leading and trailing white space from a 'ByteString'.+--+-- @since 0.10.12.0+strip :: ByteString -> ByteString+strip = dropWhile isSpace . dropWhileEnd isSpace+ {- -- | 'dropSpaceEnd' efficiently returns the 'ByteString' argument with -- white space removed from the end. I.e.@@ -846,7 +879,9 @@ -} -- | 'lines' breaks a ByteString up into a list of ByteStrings at--- newline Chars. The resulting strings do not contain newlines.+-- newline Chars (@'\\n'@). The resulting strings do not contain newlines.+--+-- Note that it __does not__ regard CR (@'\\r'@) as a newline character. -- lines :: ByteString -> [ByteString] lines ps
Data/ByteString/Internal.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE CPP, ForeignFunctionInterface, BangPatterns #-} {-# LANGUAGE UnliftedFFITypes, MagicHash, UnboxedTuples, DeriveDataTypeable #-}+{-# LANGUAGE TypeFamilies #-} #if __GLASGOW_HASKELL__ >= 703 {-# LANGUAGE Unsafe #-} #endif@@ -38,10 +39,12 @@ -- * Low level imperative construction create, -- :: Int -> (Ptr Word8 -> IO ()) -> IO ByteString createUptoN, -- :: Int -> (Ptr Word8 -> IO Int) -> IO ByteString- createAndTrim, -- :: Int -> (Ptr Word8 -> IO Int) -> IO ByteString+ createUptoN', -- :: Int -> (Ptr Word8 -> IO (Int, a)) -> IO (ByteString, a)+ createAndTrim, -- :: Int -> (Ptr Word8 -> IO Int) -> IO ByteString createAndTrim', -- :: Int -> (Ptr Word8 -> IO (Int, Int, a)) -> IO (ByteString, a)- unsafeCreate, -- :: Int -> (Ptr Word8 -> IO ()) -> ByteString- unsafeCreateUptoN, -- :: Int -> (Ptr Word8 -> IO Int) -> ByteString+ unsafeCreate, -- :: Int -> (Ptr Word8 -> IO ()) -> ByteString+ unsafeCreateUptoN, -- :: Int -> (Ptr Word8 -> IO Int) -> ByteString+ unsafeCreateUptoN', -- :: Int -> (Ptr Word8 -> IO (Int, a)) -> (ByteString, a) mallocByteString, -- :: Int -> IO (ForeignPtr a) -- * Conversion to and from ForeignPtrs@@ -117,6 +120,10 @@ import GHC.Base (nullAddr#,realWorld#,unsafeChr) +#if MIN_VERSION_base(4,7,0)+import GHC.Exts (IsList(..))+#endif+ #if MIN_VERSION_base(4,4,0) import GHC.CString (unpackCString#) #else@@ -182,6 +189,16 @@ instance Read ByteString where readsPrec p str = [ (packChars x, y) | (x, y) <- readsPrec p str ] +#if MIN_VERSION_base(4,7,0)+-- | @since 0.10.12.0+instance IsList ByteString where+ type Item ByteString = Word8+ fromList = packBytes+ toList = unpackBytes+#endif++-- | Beware: 'fromString' truncates multi-byte characters to octets.+-- e.g. "枯朶に烏のとまりけり秋の暮" becomes �6k�nh~�Q��n� instance IsString ByteString where fromString = packChars @@ -229,7 +246,7 @@ -- boxed string. A unboxed string literal is compiled to a static @char -- []@ by GHC. Establishing the length of the string requires a call to -- @strlen(3)@, so the 'Addr#' must point to a null-terminated buffer (as--- is the case with @\"string\"\#@ literals in GHC). Use 'unsafePackAddressLen'+-- is the case with @\"string\"\#@ literals in GHC). Use 'Data.ByteString.Unsafe.unsafePackAddressLen' -- if you know the length of the string statically. -- -- An example:@@ -371,11 +388,12 @@ unsafeCreateUptoN l f = unsafeDupablePerformIO (createUptoN l f) {-# INLINE unsafeCreateUptoN #-} +-- | @since 0.10.12.0 unsafeCreateUptoN' :: Int -> (Ptr Word8 -> IO (Int, a)) -> (ByteString, a) unsafeCreateUptoN' l f = unsafeDupablePerformIO (createUptoN' l f) {-# INLINE unsafeCreateUptoN' #-} --- | Create ByteString of size @l@ and use action @f@ to fill it's contents.+-- | Create ByteString of size @l@ and use action @f@ to fill its contents. create :: Int -> (Ptr Word8 -> IO ()) -> IO ByteString create l f = do fp <- mallocByteString l@@ -383,8 +401,9 @@ return $! PS fp 0 l {-# INLINE create #-} --- | Create ByteString of up to size size @l@ and use action @f@ to fill it's--- contents which returns its true size.+-- | Given a maximum size @l@ and an action @f@ that fills the 'ByteString'+-- starting at the given 'Ptr' and returns the actual utilized length,+-- @`createUpToN'` l f@ returns the filled 'ByteString'. createUptoN :: Int -> (Ptr Word8 -> IO Int) -> IO ByteString createUptoN l f = do fp <- mallocByteString l@@ -392,7 +411,10 @@ assert (l' <= l) $ return $! PS fp 0 l' {-# INLINE createUptoN #-} --- | Create ByteString of up to size @l@ and use action @f@ to fill it's contents which returns its true size.+-- | Like 'createUpToN', but also returns an additional value created by the+-- action.+--+-- @since 0.10.12.0 createUptoN' :: Int -> (Ptr Word8 -> IO (Int, a)) -> IO (ByteString, a) createUptoN' l f = do fp <- mallocByteString l@@ -429,7 +451,7 @@ memcpy p' (p `plusPtr` off) l' return (ps, res) --- | Wrapper of 'mallocForeignPtrBytes' with faster implementation for GHC+-- | Wrapper of 'Foreign.ForeignPtr.mallocForeignPtrBytes' with faster implementation for GHC -- mallocByteString :: Int -> IO (ForeignPtr a) mallocByteString = mallocPlainForeignPtrBytes@@ -569,7 +591,7 @@ ------------------------------------------------------------------------ --- | This \"function\" has a superficial similarity to 'unsafePerformIO' but+-- | This \"function\" has a superficial similarity to 'System.IO.Unsafe.unsafePerformIO' but -- it is in fact a malevolent agent of chaos. It unpicks the seams of reality -- (and the 'IO' monad) so that the normal rules no longer apply. It lulls you -- into thinking it is reasonable, but when you are not looking it stabs you@@ -600,7 +622,7 @@ inlinePerformIO :: IO a -> a inlinePerformIO = accursedUnutterablePerformIO {-# INLINE inlinePerformIO #-}-{-# DEPRECATED inlinePerformIO "If you think you know what you are doing, use 'unsafePerformIO'. If you are sure you know what you are doing, use 'unsafeDupablePerformIO'. If you enjoy sharing an address space with a malevolent agent of chaos, try 'accursedUnutterablePerformIO'." #-}+{-# DEPRECATED inlinePerformIO "If you think you know what you are doing, use 'System.IO.Unsafe.unsafePerformIO'. If you are sure you know what you are doing, use 'unsafeDupablePerformIO'. If you enjoy sharing an address space with a malevolent agent of chaos, try 'accursedUnutterablePerformIO'." #-} -- --------------------------------------------------------------------- --
Data/ByteString/Lazy.hs view
@@ -171,6 +171,7 @@ elemIndexEnd, -- :: Word8 -> ByteString -> Maybe Int64 elemIndices, -- :: Word8 -> ByteString -> [Int64] findIndex, -- :: (Word8 -> Bool) -> ByteString -> Maybe Int64+ findIndexEnd, -- :: (Word8 -> Bool) -> ByteString -> Maybe Int64 findIndices, -- :: (Word8 -> Bool) -> ByteString -> [Int64] count, -- :: Word8 -> ByteString -> Int64 @@ -343,7 +344,7 @@ null _ = False {-# INLINE null #-} --- | /O(n\/c)/ 'length' returns the length of a ByteString as an 'Int64'+-- | /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 #-}@@ -351,7 +352,7 @@ infixr 5 `cons`, `cons'` --same as list (:) infixl 5 `snoc` --- | /O(1)/ 'cons' is analogous to '(:)' for lists.+-- | /O(1)/ 'cons' is analogous to '(Prelude.:)' for lists. -- cons :: Word8 -> ByteString -> ByteString cons c cs = Chunk (S.singleton c) cs@@ -503,7 +504,7 @@ {-# INLINE foldr #-} -- | 'foldl1' is a variant of 'foldl' that has no starting value--- argument, and thus must be applied to non-empty 'ByteStrings'.+-- argument, and thus must be applied to non-empty 'ByteString's. foldl1 :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8 foldl1 _ Empty = errorEmptyList "foldl1" foldl1 f (Chunk c cs) = foldl f (S.unsafeHead c) (Chunk (S.unsafeTail c) cs)@@ -752,7 +753,7 @@ -- of the specified byte. It is more efficient than 'break' as it is -- implemented with @memchr(3)@. I.e. ----- > break (=='c') "abcd" == breakByte 'c' "abcd"+-- > break (==99) "abcd" == breakByte 99 "abcd" -- fromEnum 'c' == 99 -- breakByte :: Word8 -> ByteString -> (ByteString, ByteString) breakByte c (LPS ps) = case (breakByte' ps) of (a,b) -> (LPS a, LPS b)@@ -768,7 +769,7 @@ -- occurence of a byte other than its argument. It is more efficient -- than 'span (==)' ----- > span (=='c') "abcd" == spanByte 'c' "abcd"+-- > span (==99) "abcd" == spanByte 99 "abcd" -- fromEnum 'c' == 99 -- spanByte :: Word8 -> ByteString -> (ByteString, ByteString) spanByte c (LPS ps) = case (spanByte' ps) of (a,b) -> (LPS a, LPS b)@@ -791,8 +792,8 @@ -- The resulting components do not contain the separators. Two adjacent -- separators result in an empty component in the output. eg. ----- > splitWith (=='a') "aabbaca" == ["","","bb","c",""]--- > splitWith (=='a') [] == []+-- > splitWith (==97) "aabbaca" == ["","","bb","c",""] -- fromEnum 'a' == 97+-- > splitWith (==97) [] == [] -- splitWith :: (Word8 -> Bool) -> ByteString -> [ByteString] splitWith _ Empty = []@@ -807,9 +808,9 @@ -- | /O(n)/ Break a 'ByteString' into pieces separated by the byte -- argument, consuming the delimiter. I.e. ----- > split '\n' "a\nb\nd\ne" == ["a","b","d","e"]--- > split 'a' "aXaXaXa" == ["","X","X","X",""]--- > split 'x' "x" == ["",""]+-- > split 10 "a\nb\nd\ne" == ["a","b","d","e"] -- fromEnum '\n' == 10+-- > split 97 "aXaXaXa" == ["","X","X","X",""] -- fromEnum 'a' == 97+-- > split 120 "x" == ["",""] -- fromEnum 'x' == 120 -- -- and --@@ -817,7 +818,7 @@ -- > split == splitWith . (==) -- -- As for all splitting functions in this library, this function does--- not copy the substrings, it just constructs new 'ByteStrings' that+-- not copy the substrings, it just constructs new 'ByteString's that -- are slices of the original. -- split :: Word8 -> ByteString -> [ByteString]@@ -916,13 +917,8 @@ -- -- @since 0.10.6.0 elemIndexEnd :: Word8 -> ByteString -> Maybe Int64-elemIndexEnd w = elemIndexEnd' 0- where- elemIndexEnd' _ Empty = Nothing- elemIndexEnd' n (Chunk c cs) =- let !n' = n + S.length c- !i = fmap (fromIntegral . (n +)) $ S.elemIndexEnd w c- in elemIndexEnd' n' cs `mplus` i+elemIndexEnd = findIndexEnd . (==)+{-# INLINE elemIndexEnd #-} -- | /O(n)/ The 'elemIndices' function extends 'elemIndex', by returning -- the indices of all elements equal to the query element, in ascending order.@@ -952,6 +948,21 @@ Nothing -> findIndex' (n + fromIntegral (S.length c)) cs Just i -> Just (n + fromIntegral i) {-# 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.10.12.0+findIndexEnd :: (Word8 -> Bool) -> ByteString -> Maybe Int64+findIndexEnd k = findIndexEnd' 0+ where+ findIndexEnd' _ Empty = Nothing+ findIndexEnd' n (Chunk c cs) =+ let !n' = n + S.length c+ !i = fmap (fromIntegral . (n +)) $ S.findIndexEnd k c+ in findIndexEnd' n' cs `mplus` i+{-# INLINE findIndexEnd #-} -- | /O(n)/ The 'find' function takes a predicate and a ByteString, -- and returns the first element in matching the predicate, or 'Nothing'
Data/ByteString/Lazy/Builder.hs view
@@ -1,10 +1,10 @@ -- | We decided to rename the Builder modules. Sorry about that. ----- The old names will hang about for at least once release cycle before we--- deprecate them and then later remove them.+-- The old names will hang about for at least once release cycle and then later remove them. ---module Data.ByteString.Lazy.Builder (+module Data.ByteString.Lazy.Builder+ {-# DEPRECATED "Use Data.ByteString.Builder instead" #-} ( module Data.ByteString.Builder ) where
Data/ByteString/Lazy/Builder/ASCII.hs view
@@ -4,10 +4,10 @@ -- In additon, the ASCII module has been merged into the main -- "Data.ByteString.Builder" module. ----- The old names will hang about for at least once release cycle before we--- deprecate them and then later remove them.+-- The old names will hang about for at least once release cycle and then later remove them. ---module Data.ByteString.Lazy.Builder.ASCII (+module Data.ByteString.Lazy.Builder.ASCII+ {-# DEPRECATED "Use Data.ByteString.Builder instead" #-} ( module Data.ByteString.Builder , byteStringHexFixed , lazyByteStringHexFixed@@ -19,6 +19,8 @@ byteStringHexFixed :: S.ByteString -> Builder byteStringHexFixed = byteStringHex+{-# DEPRECATED byteStringHexFixed "Use byteStringHex instead" #-} lazyByteStringHexFixed :: L.ByteString -> Builder lazyByteStringHexFixed = lazyByteStringHex+{-# DEPRECATED lazyByteStringHexFixed "Use lazyByteStringHex instead" #-}
Data/ByteString/Lazy/Builder/Extras.hs view
@@ -1,10 +1,10 @@ -- | We decided to rename the Builder modules. Sorry about that. ----- The old names will hang about for at least once release cycle before we--- deprecate them and then later remove them.+-- The old names will hang about for at least once release cycle and then later remove them. ---module Data.ByteString.Lazy.Builder.Extras (+module Data.ByteString.Lazy.Builder.Extras+ {-# DEPRECATED "Use Data.ByteString.Builder.Extra instead" #-} ( module Data.ByteString.Builder.Extra ) where
Data/ByteString/Lazy/Char8.hs view
@@ -142,7 +142,7 @@ -- ** Searching with a predicate find, -- :: (Char -> Bool) -> ByteString -> Maybe Char filter, -- :: (Char -> Bool) -> ByteString -> ByteString--- partition -- :: (Char -> Bool) -> ByteString -> (ByteString, ByteString)+ partition, -- :: (Char -> Bool) -> ByteString -> (ByteString, ByteString) -- * Indexing ByteStrings index, -- :: ByteString -> Int64 -> Char@@ -196,7 +196,7 @@ ) where -- Functions transparently exported-import Data.ByteString.Lazy +import Data.ByteString.Lazy (fromChunks, toChunks, fromStrict, toStrict ,empty,null,length,tail,init,append,reverse,transpose,cycle ,concat,take,drop,splitAt,intercalate@@ -219,7 +219,7 @@ import Data.Int (Int64) import qualified Data.List as List -import Prelude hiding +import Prelude hiding (reverse,head,tail,last,init,null,length,map,lines,foldl,foldr,unlines ,concat,any,take,drop,splitAt,takeWhile,dropWhile,span,break,elem,filter ,unwords,words,maximum,minimum,all,concatMap,scanl,scanl1,foldl1,foldr1@@ -235,7 +235,7 @@ singleton = L.singleton . c2w {-# INLINE singleton #-} --- | /O(n)/ Convert a 'String' into a 'ByteString'. +-- | /O(n)/ Convert a 'String' into a 'ByteString'. pack :: [Char] -> ByteString pack = packChars @@ -246,7 +246,7 @@ infixr 5 `cons`, `cons'` --same as list (:) infixl 5 `snoc` --- | /O(1)/ 'cons' is analogous to '(:)' for lists.+-- | /O(1)/ 'cons' is analogous to '(Prelude.:)' for lists. cons :: Char -> ByteString -> ByteString cons = L.cons . c2w {-# INLINE cons #-}@@ -332,7 +332,7 @@ {-# INLINE foldr #-} -- | 'foldl1' is a variant of 'foldl' that has no starting value--- argument, and thus must be applied to non-empty 'ByteStrings'.+-- argument, and thus must be applied to non-empty 'ByteString's. foldl1 :: (Char -> Char -> Char) -> ByteString -> Char foldl1 f ps = w2c (L.foldl1 (\x y -> c2w (f (w2c x) (w2c y))) ps) {-# INLINE foldl1 #-}@@ -465,7 +465,7 @@ -- | 'breakChar' breaks its ByteString argument at the first occurence -- of the specified Char. It is more efficient than 'break' as it is -- implemented with @memchr(3)@. I.e.--- +-- -- > break (=='c') "abcd" == breakChar 'c' "abcd" -- breakChar :: Char -> ByteString -> (ByteString, ByteString)@@ -493,14 +493,14 @@ -- > split '\n' "a\nb\nd\ne" == ["a","b","d","e"] -- > split 'a' "aXaXaXa" == ["","X","X","X"] -- > split 'x' "x" == ["",""]--- +-- -- and -- -- > intercalate [c] . split c == id -- > split == splitWith . (==)--- +-- -- As for all splitting functions in this library, this function does--- not copy the substrings, it just constructs new 'ByteStrings' that+-- not copy the substrings, it just constructs new 'ByteString's that -- are slices of the original. -- split :: Char -> ByteString -> [ByteString]@@ -578,6 +578,11 @@ filter f = L.filter (f . w2c) {-# INLINE filter #-} +-- | @since 0.10.12.0+partition :: (Char -> Bool) -> ByteString -> (ByteString, ByteString)+partition f = L.partition (f . w2c)+{-# INLINE partition #-}+ {- -- | /O(n)/ and /O(n\/c) space/ A first order equivalent of /filter . -- (==)/, for the common case of filtering a single Char. It is more@@ -656,10 +661,12 @@ zipWith f = L.zipWith ((. w2c) . f . w2c) -- | 'lines' breaks a ByteString up into a list of ByteStrings at--- newline Chars. The resulting strings do not contain newlines.+-- newline Chars (@'\\n'@). The resulting strings do not contain newlines. ----- As of bytestring 0.9.0.3, this function is stricter than its +-- As of bytestring 0.9.0.3, this function is stricter than its -- list cousin.+--+-- Note that it __does not__ regard CR (@'\\r'@) as a newline character. -- lines :: ByteString -> [ByteString] lines Empty = []
Data/ByteString/Lazy/Internal.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TypeFamilies #-} #if __GLASGOW_HASKELL__ >= 703 {-# LANGUAGE Unsafe #-} #endif@@ -13,7 +14,7 @@ -- Maintainer : dons00@gmail.com, duncan@community.haskell.org -- Stability : unstable -- Portability : non-portable--- +-- -- A module containing semi-public 'ByteString' internals. This exposes -- the 'ByteString' representation and low level construction functions. -- Modules which extend the 'ByteString' system will need to use this module@@ -68,6 +69,10 @@ import Data.Typeable (Typeable) import Data.Data (Data(..), mkNoRepType) +#if MIN_VERSION_base(4,7,0)+import GHC.Exts (IsList(..))+#endif+ -- | A space-efficient representation of a 'Word8' vector, supporting many -- efficient operations. --@@ -110,6 +115,16 @@ instance Read ByteString where readsPrec p str = [ (packChars x, y) | (x, y) <- readsPrec p str ] +#if MIN_VERSION_base(4,7,0)+-- | @since 0.10.12.0+instance IsList ByteString where+ type Item ByteString = Word8+ fromList = packBytes+ toList = unpackBytes+#endif++-- | Beware: 'fromString' truncates multi-byte characters to octets.+-- e.g. "枯朶に烏のとまりけり秋の暮" becomes �6k�nh~�Q��n� instance IsString ByteString where fromString = packChars
Data/ByteString/Short.hs view
@@ -11,7 +11,7 @@ -- Maintainer : duncan@community.haskell.org -- Stability : stable -- Portability : ghc only--- +-- -- A compact representation suitable for storing short byte strings in memory. -- -- In typical use cases it can be imported alongside "Data.ByteString", e.g.@@ -36,20 +36,20 @@ -- | With GHC, the memory overheads are as follows, expressed in words and -- in bytes (words are 4 and 8 bytes on 32 or 64bit machines respectively). --- -- * 'ByteString' unshared: 9 words; 36 or 72 bytes.+ -- * 'B.ByteString' unshared: 9 words; 36 or 72 bytes. --- -- * 'ByteString' shared substring: 5 words; 20 or 40 bytes.+ -- * 'B.ByteString' shared substring: 5 words; 20 or 40 bytes. -- -- * 'ShortByteString': 4 words; 16 or 32 bytes. --- -- For the string data itself, both 'ShortByteString' and 'ByteString' use+ -- For the string data itself, both 'ShortByteString' and 'B.ByteString' use -- one byte per element, rounded up to the nearest word. For example, -- including the overheads, a length 10 'ShortByteString' would take -- @16 + 12 = 28@ bytes on a 32bit platform and @32 + 16 = 48@ bytes on a -- 64bit platform. -- -- These overheads can all be reduced by 1 word (4 or 8 bytes) when the- -- 'ShortByteString' or 'ByteString' is unpacked into another constructor.+ -- 'ShortByteString' or 'B.ByteString' is unpacked into another constructor. -- -- For example: --@@ -59,9 +59,9 @@ -- This will take @1 + 1 + 3@ words (the @ThingId@ constructor + -- unpacked @Int@ + unpacked @ShortByteString@), plus the words for the -- string data.- + -- ** Heap fragmentation- -- | With GHC, the 'ByteString' representation uses /pinned/ memory,+ -- | With GHC, the 'B.ByteString' representation uses /pinned/ memory, -- meaning it cannot be moved by the GC. This is usually the right thing to -- do for larger strings, but for small strings using pinned memory can -- lead to heap fragmentation which wastes space. The 'ShortByteString'@@ -80,11 +80,11 @@ empty, null, length, index, -- * Low level conversions- -- ** Packing 'CString's and pointers+ -- ** Packing 'Foreign.C.String.CString's and pointers packCString, packCStringLen, - -- ** Using ByteStrings as 'CString's+ -- ** Using ByteStrings as 'Foreign.C.String.CString's useAsCString, useAsCStringLen ) where
Data/ByteString/Short/Internal.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE DeriveDataTypeable, CPP, BangPatterns, RankNTypes, ForeignFunctionInterface, MagicHash, UnboxedTuples, UnliftedFFITypes #-}+{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} #if __GLASGOW_HASKELL__ >= 703 {-# LANGUAGE Unsafe #-}@@ -15,7 +16,7 @@ -- Maintainer : duncan@community.haskell.org -- Stability : stable -- Portability : ghc only--- +-- -- Internal representation of ShortByteString -- module Data.ByteString.Short.Internal (@@ -170,6 +171,16 @@ instance Read ShortByteString where readsPrec p str = [ (packChars x, y) | (x, y) <- readsPrec p str ] +#if MIN_VERSION_base(4,7,0)+-- | @since 0.10.12.0+instance GHC.Exts.IsList ShortByteString where+ type Item ShortByteString = Word8+ fromList = packBytes+ toList = unpackBytes+#endif++-- | Beware: 'fromString' truncates multi-byte characters to octets.+-- e.g. "枯朶に烏のとまりけり秋の暮" becomes �6k�nh~�Q��n� instance IsString ShortByteString where fromString = packChars @@ -198,7 +209,7 @@ null :: ShortByteString -> Bool null sbs = length sbs == 0 --- | /O(1)/ 'ShortByteString' index (subscript) operator, starting from 0. +-- | /O(1)/ 'ShortByteString' index (subscript) operator, starting from 0. index :: ShortByteString -> Int -> Word8 index sbs i | i >= 0 && i < length sbs = unsafeIndex sbs i
Data/ByteString/Unsafe.hs view
@@ -213,7 +213,7 @@ -- -- This function is also unsafe if you call its finalizer twice, -- which will result in a /double free/ error, or if you pass it--- a 'CString' not allocated with 'malloc'.+-- a 'CString' not allocated with 'Foreign.Marshal.Alloc.malloc'. -- unsafePackMallocCString :: CString -> IO ByteString unsafePackMallocCString cstr = do@@ -230,7 +230,7 @@ -- -- This function is also unsafe if you call its finalizer twice, -- which will result in a /double free/ error, or if you pass it--- a 'CString' not allocated with 'malloc'.+-- a 'CString' not allocated with 'Foreign.Marshal.Alloc.malloc'. -- unsafePackMallocCStringLen :: CStringLen -> IO ByteString unsafePackMallocCStringLen (cstr, len) = do@@ -252,13 +252,13 @@ -- 'ByteString's created by sharing (such as those produced via 'take' -- or 'drop') will also reflect these changes. Modifying the 'CString' -- will break referential transparency. To avoid this, use--- 'useAsCString', which makes a copy of the original 'ByteString'.+-- 'Data.ByteString.useAsCString', which makes a copy of the original 'ByteString'. -- -- * 'CString's are often passed to functions that require them to be -- null-terminated. If the original 'ByteString' wasn't null terminated, -- neither will the 'CString' be. It is the programmers responsibility -- to guarantee that the 'ByteString' is indeed null terminated. If in--- doubt, use 'useAsCString'.+-- doubt, use 'Data.ByteString.useAsCString'. -- -- * The memory may freed at any point after the subcomputation -- terminates, so the pointer to the storage must *not* be used@@ -280,7 +280,8 @@ -- 'ByteString's created by sharing (such as those produced via 'take' -- or 'drop') will also reflect these changes. Modifying the 'CStringLen' -- will break referential transparency. To avoid this, use--- 'useAsCStringLen', which makes a copy of the original 'ByteString'.+-- 'Data.ByteString.useAsCStringLen', which makes a copy of the original 'ByteString'. --+-- If 'Data.ByteString.empty' is given, it will pass @('Foreign.Ptr.nullPtr', 0)@. unsafeUseAsCStringLen :: ByteString -> (CStringLen -> IO a) -> IO a unsafeUseAsCStringLen (PS ps s l) f = withForeignPtr ps $ \p -> f (castPtr p `plusPtr` s,l)
bytestring.cabal view
@@ -1,5 +1,5 @@ Name: bytestring-Version: 0.10.10.1+Version: 0.10.12.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)@@ -146,111 +146,3 @@ if impl(ghc >= 6.9) && impl(ghc < 6.11) cpp-options: -DINTEGER_GMP build-depends: integer >= 0.1 && < 0.2----- QC properties, with GHC RULES disabled-test-suite prop-compiled- type: exitcode-stdio-1.0- main-is: Properties.hs- other-modules: Rules- QuickCheckUtils- TestFramework- Data.ByteString- Data.ByteString.Char8- Data.ByteString.Internal- Data.ByteString.Lazy- Data.ByteString.Lazy.Char8- Data.ByteString.Lazy.Internal- Data.ByteString.Short- Data.ByteString.Short.Internal- Data.ByteString.Unsafe- hs-source-dirs: . tests- build-depends: base, ghc-prim, deepseq, random, directory,- test-framework, test-framework-quickcheck2,- QuickCheck >= 2.10 && < 2.15- c-sources: cbits/fpstring.c- include-dirs: include- ghc-options: -fwarn-unused-binds- -fno-enable-rewrite-rules- -threaded -rtsopts- cpp-options: -DHAVE_TEST_FRAMEWORK=1- default-language: Haskell98- -- older ghc had issues with language pragmas guarded by cpp- if impl(ghc < 7)- default-extensions: CPP, MagicHash, UnboxedTuples,- DeriveDataTypeable, BangPatterns,- NamedFieldPuns--test-suite regressions- -- temporarily disabled as it allocates too much memory- buildable: False- type: exitcode-stdio-1.0- main-is: Regressions.hs- hs-source-dirs: . tests- build-depends: base, ghc-prim, deepseq, random, directory,- test-framework, test-framework-hunit, HUnit- c-sources: cbits/fpstring.c- include-dirs: include- ghc-options: -fwarn-unused-binds- -fno-enable-rewrite-rules- -threaded -rtsopts- default-language: Haskell98- -- older ghc had issues with language pragmas guarded by cpp- if impl(ghc < 7)- default-extensions: CPP, MagicHash, UnboxedTuples,- DeriveDataTypeable, BangPatterns,- NamedFieldPuns--test-suite test-builder- type: exitcode-stdio-1.0- hs-source-dirs: . tests tests/builder- main-is: TestSuite.hs- other-modules: Data.ByteString- Data.ByteString.Internal- Data.ByteString.Lazy- Data.ByteString.Lazy.Internal- Data.ByteString.Short- Data.ByteString.Short.Internal- Data.ByteString.Unsafe- Data.ByteString.Builder- Data.ByteString.Builder.ASCII- Data.ByteString.Builder.Extra- Data.ByteString.Builder.Internal- Data.ByteString.Builder.Prim- Data.ByteString.Builder.Prim.ASCII- Data.ByteString.Builder.Prim.Binary- Data.ByteString.Builder.Prim.Internal- Data.ByteString.Builder.Prim.Internal.Base16- Data.ByteString.Builder.Prim.Internal.Floating- Data.ByteString.Builder.Prim.Internal.UncheckedShifts- Data.ByteString.Builder.Prim.TestUtils- Data.ByteString.Builder.Prim.Tests- Data.ByteString.Builder.Tests- TestFramework- build-depends: base, ghc-prim,- deepseq,- QuickCheck >= 2.10 && < 2.15,- byteorder == 1.0.*,- dlist >= 0.5 && < 0.9,- directory,- mtl >= 2.0 && < 2.3,- HUnit,- test-framework,- test-framework-hunit,- test-framework-quickcheck2-- ghc-options: -Wall -fwarn-tabs -threaded -rtsopts- cpp-options: -DHAVE_TEST_FRAMEWORK=1-- default-language: Haskell98- -- older ghc had issues with language pragmas guarded by cpp- if impl(ghc < 7)- default-extensions: CPP, MagicHash, UnboxedTuples,- DeriveDataTypeable, BangPatterns,- NamedFieldPuns-- c-sources: cbits/fpstring.c- cbits/itoa.c- include-dirs: include- includes: fpstring.h- install-includes: fpstring.h
− tests/Properties.hs
@@ -1,2443 +0,0 @@-{-# LANGUAGE CPP, ScopedTypeVariables, BangPatterns #-}------ 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.Storable-import Foreign.ForeignPtr-import Foreign.Marshal.Alloc-import Foreign.Marshal.Array-import GHC.Ptr-import Test.QuickCheck-import Control.Applicative-import Control.Monad-import Control.Concurrent-import Control.Exception-import System.Directory--import Data.List-import Data.Char-import Data.Word-import Data.Maybe-import Data.Int (Int64)-import Data.Monoid--import Text.Printf-import Data.String--import System.Environment-import System.IO-import System.IO.Unsafe--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-#if defined(HAVE_TEST_FRAMEWORK)-import Test.Framework-import Test.Framework.Providers.QuickCheck2-#else-import TestFramework-#endif--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_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_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_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_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_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])------- 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_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_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_zipWithPL' = P.zipWith' `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_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_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_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_drop1 i xs = L.drop (fromIntegral i) (pack xs) == pack (drop 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_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_breakByte xs c = L.break (== c) xs == L.breakByte c xs---- prop_spanByte c xs = (L.span (==c) xs) == L.spanByte c xs--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 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 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 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_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)--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_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 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_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 xs a = (takeWhile (/= a) xs) == (P.unpack . (P.takeWhile (/= a)) . P.pack) xs--prop_dropWhileBB 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_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 c 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_elemIndexEnd2BB c xs = (P.elemIndexEnd c (P.pack xs)) ==- ((-) (length xs - 1) `fmap` P.elemIndex c (P.pack $ reverse xs))--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_elemIndexEnd2LL c xs = (L.elemIndexEnd c (L.pack xs)) ==- ((-) (fromIntegral (length xs) - 1) `fmap` L.elemIndex c (L.pack $ reverse xs))--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_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_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, chr (ord x + 1))--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))---- The correspondence between the test 'ByteString' and naive test 'String'--- must be injective, otherwise the ByteString may find matches at positions--- that don't match in the "corresponding" string. To that end, we start--- with and pack a Word8 array, rather than a unicode String.----prop_findSubstringsBB :: [Word8] -> Int -> Int -> Bool-prop_findSubstringsBB ws x l- = let bstr = P.pack ws- -- we look for some random substring of the test string- slice = C.take l $ C.drop x bstr- str = C.unpack bstr- substr = C.unpack slice- in C.findSubstrings slice bstr == naive_findSubstrings substr str- where- -- naive reference implementation- -- Note, overlapping matches have been broken since 2015, so at this- -- point just test for the current behaviour.- naive_findSubstrings :: String -> String -> [Int]- naive_findSubstrings p q- | null p = [0..length q]- | otherwise = go 0 (length p) p (length q) q- go n !lp p !lq q =- if (lp > lq)- then []- else if p `isPrefixOf` q- then n : go (n + lp) lp p (lq - lp) (drop lp q)- else go (n + 1) lp p (lq - 1) (tail q)---- See above re injective string -> bytestring correspondence.-prop_findSubstringBB :: [Word8] -> Int -> Int -> Bool-prop_findSubstringBB ws x l- = let bstr = P.pack ws- -- we look for some random substring of the test string- slice = C.take l $ C.drop x bstr- str = C.unpack bstr- substr = C.unpack slice- in C.findSubstring slice bstr == naive_findSubstring substr str- where- -- naive reference implementation- naive_findSubstring :: String -> String -> Maybe Int- naive_findSubstring p q = listToMaybe [x | x <- [0..length q], p `isPrefixOf` drop x q]---- 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_breakSubstring_findSubstring s l- = P.findSubstring s l == if P.null s then Just 0- else case P.breakSubstring s l of- (x,y) | P.null y -> Nothing- | otherwise -> Just (P.length x)--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---- 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_zipWith'BB xs ys = P.pack (P.zipWith (+) xs ys) == P.zipWith' (+) xs ys--prop_unzipBB x = let (xs,ys) = unzip x in (P.pack xs, P.pack ys) == P.unzip x----- 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---- prop_break_spec x s =--- P.break ((==) x) s == P.breakByte x s---- prop_span_spec x s =--- P.span ((==) x) s == P.spanByte x s------------------------------------------------------------------------------ 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) = unsafePerformIO $ 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 = unsafePerformIO $ 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 = unsafePerformIO $ 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 = unsafePerformIO $ 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 = unsafePerformIO $ 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) = unsafePerformIO $ do- y <- P.useAsCString x $ P.unsafePackCString- return (y == x)--prop_packCString_safe (CByteString x) = unsafePerformIO $ do- y <- P.useAsCString x $ P.packCString- return (y == x)--prop_packCStringLen x = unsafePerformIO $ do- y <- P.useAsCStringLen x $ P.unsafePackCStringLen- return (y == x && P.length y == P.length x)--prop_packCStringLen_safe x = unsafePerformIO $ do- y <- P.useAsCStringLen x $ P.packCStringLen- return (y == x && P.length y == P.length x)--prop_packMallocCString (CByteString x) = unsafePerformIO $ 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 ==>- unsafePerformIO $ do- x <- P.unsafeFinalize x- return (x == ())--prop_packCStringFinaliser x = unsafePerformIO $ 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 = unsafePerformIO $ do- tid <- myThreadId- let f = "qc-test-"++show tid- bracket- (do P.writeFile f x)- (const $ do removeFile f)- (const $ do y <- P.readFile f- return (x==y))--prop_read_write_file_C x = unsafePerformIO $ do- tid <- myThreadId- let f = "qc-test-"++show tid- bracket- (do C.writeFile f x)- (const $ do removeFile f)- (const $ do y <- C.readFile f- return (x==y))--prop_read_write_file_L x = unsafePerformIO $ do- tid <- myThreadId- let f = "qc-test-"++show tid- bracket- (do L.writeFile f x)- (const $ do removeFile f)- (const $ do y <- L.readFile f- return (x==y))--prop_read_write_file_D x = unsafePerformIO $ do- tid <- myThreadId- let f = "qc-test-"++show tid- bracket- (do D.writeFile f x)- (const $ do removeFile f)- (const $ do y <- D.readFile f- return (x==y))----------------------------------------------------------------------------prop_append_file_P x y = unsafePerformIO $ do- tid <- myThreadId- let f = "qc-test-"++show tid- bracket- (do P.writeFile f x- P.appendFile f y)- (const $ do removeFile f)- (const $ do z <- P.readFile f- return (z==(x `P.append` y)))--prop_append_file_C x y = unsafePerformIO $ do- tid <- myThreadId- let f = "qc-test-"++show tid- bracket- (do C.writeFile f x- C.appendFile f y)- (const $ do removeFile f)- (const $ do z <- C.readFile f- return (z==(x `C.append` y)))--prop_append_file_L x y = unsafePerformIO $ do- tid <- myThreadId- let f = "qc-test-"++show tid- bracket- (do L.writeFile f x- L.appendFile f y)- (const $ do removeFile f)- (const $ do z <- L.readFile f- return (z==(x `L.append` y)))--prop_append_file_D x y = unsafePerformIO $ do- tid <- myThreadId- let f = "qc-test-"++show tid- bracket- (do D.writeFile f x- D.appendFile f y)- (const $ do removeFile f)- (const $ do z <- D.readFile f- return (z==(x `D.append` y)))--prop_packAddress = C.pack "this is a test"- ==- C.pack "this is a test"--prop_isSpaceWord8 (w :: Word8) = isSpace c == P.isSpaceChar8 c- where c = chr (fromIntegral w)------------------------------------------------------------------------------ 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--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- ]----------------------------------------------------------------------------- The entry point--main :: IO ()-main = defaultMainWithArgs tests ["-o 3"] -- timeout if a test runs for >3 secs------- 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 "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 "elemIndices" prop_elemIndicesBL- , testProperty "concatMap" prop_concatMapBL- ]----------------------------------------------------------------------------- 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_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 "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 "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 "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 "zipWith" prop_zipWithPL--- , testProperty "zipWith" prop_zipWithCL- , testProperty "zipWith rules" prop_zipWithPL_rules--- , testProperty "zipWith/zipWith'" prop_zipWithPL'-- , 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" prop_takeWhileBB- , testProperty "dropWhile" prop_dropWhileBB- , testProperty "dropWhile" 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 "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 "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 "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 1" prop_elemIndexEnd1BB- , testProperty "elemIndexEnd 1" prop_elemIndexEnd1CC- , testProperty "elemIndexEnd 2" prop_elemIndexEnd2BB- , testProperty "elemIndexEnd 1" prop_elemIndexEnd1LL- , testProperty "elemIndexEnd 2" prop_elemIndexEnd2LL--- , 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 "findSubstrings "prop_findSubstringsBB- , testProperty "findSubstring "prop_findSubstringBB- , testProperty "breakSubstring 1"prop_breakSubstringBB- , testProperty "breakSubstring 2"prop_breakSubstring_findSubstring- , 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 "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" prop_splitWithBB- , 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 "zipWith" prop_zipWithBB- , testProperty "zipWith" prop_zipWithCC- , testProperty "zipWith" prop_zipWithLC--- , testProperty "zipWith'" prop_zipWith'BB- , testProperty "unzip" prop_unzipBB- , testProperty "concatMap" prop_concatMapBB--- , testProperty "join/joinByte" prop_join_spec--- , testProperty "span/spanByte" prop_span_spec--- , testProperty "break/breakByte"prop_break_spec- ]------------------------------------------------------------------------------ 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 "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 "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 "replicate 1" prop_replicate1- , testProperty "replicate 2" prop_replicate2- , testProperty "take" prop_take1- , testProperty "drop" prop_drop1- , testProperty "splitAt" prop_drop1- , testProperty "takeWhile" prop_takeWhile- , testProperty "dropWhile" prop_dropWhile- , testProperty "break" prop_break- , testProperty "span" prop_span- , testProperty "splitAt" prop_splitAt- , testProperty "break/span" prop_breakspan--- , testProperty "break/breakByte" prop_breakByte--- , testProperty "span/spanByte" prop_spanByte- , testProperty "split" prop_split- , testProperty "splitWith" prop_splitWith- , testProperty "splitWith" prop_splitWith_D- , testProperty "splitWith" prop_splitWith_C- , 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 "elemIndex" prop_elemIndex- , testProperty "elemIndices" prop_elemIndices- , testProperty "count/elemIndices" prop_count- , testProperty "findIndex" prop_findIndex- , 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- ]--
− tests/QuickCheckUtils.hs
@@ -1,204 +0,0 @@-{-# LANGUAGE CPP, MultiParamTypeClasses,- FlexibleInstances, FlexibleContexts,- TypeSynonymInstances #-}------ Uses multi-param type classes----module QuickCheckUtils where--import Test.QuickCheck-import Text.Show.Functions--import Control.Monad ( liftM2 )-import Control.Monad.Instances-import Data.Char-import Data.List-import Data.Word-import Data.Int-import System.Random-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----------------------------------------------------------------------------integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)-integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,- fromIntegral b :: Integer) g of- (x,g) -> (fromIntegral x, g)--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/Regressions.hs
@@ -1,25 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}--import Control.Exception (SomeException, handle)-import Test.HUnit (assertBool, assertEqual, assertFailure)-import qualified Data.ByteString as B-import qualified Test.Framework as F-import qualified Test.Framework.Providers.HUnit as F---- Try to generate arguments to concat that are big enough to cause an--- Int to overflow.-concat_overflow :: IO ()-concat_overflow =- handle (\(_::SomeException) -> return ()) $- B.concat (replicate lsize (B.replicate bsize 0)) `seq`- assertFailure "T.replicate should crash"- where- (lsize, bsize) | maxBound == (2147483647::Int) = (2^14, 2^18)- | otherwise = (2^34, 2^29)--tests :: [F.Test]-tests = [- F.testCase "concat_overflow" concat_overflow- ]--main = F.defaultMain tests
− tests/Rules.hs
@@ -1,48 +0,0 @@-{-# LANGUAGE CPP #-}--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--#if defined(HAVE_TEST_FRAMEWORK)-import Test.Framework.Providers.QuickCheck2-#else-import TestFramework-#endif---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/TestFramework.hs
@@ -1,70 +0,0 @@--- |--- Copyright : (c) 2011 Duncan Coutts------ test-framework stub API------ Currently we cannot use the nice test-framework package for this testsuite--- since test-framework indirectly depends on bytestring and this makes cabal--- think we've got a circular dependency.------ On the other hand, it's very nice to have the testsuite run automatically--- rather than being a totally separate package (which would fix).------ So until we can fix that we implement our own trivial layer.----module TestFramework where--import Test.QuickCheck (Testable(..))-import Test.QuickCheck.Test--import Text.Printf-import System.Environment-import Control.Monad-import Control.Exception---- Ideally we'd be using:----import Test.Framework---import Test.Framework.Providers.QuickCheck2--type TestName = String-type Test = [(TestName, Int -> IO (Bool, Int))]--testGroup :: String -> [Test] -> Test-testGroup _ = concat--testProperty :: Testable a => String -> a -> Test-testProperty name p = [(name, runQcTest)]- where- runQcTest n = do- result <- quickCheckWithResult testArgs p- case result of- Success {} -> return (True, numTests result)- _ -> return (False, numTests result)- where- testArgs = stdArgs {- maxSuccess = n- --chatty = ... if we want to increase verbosity- }--assertBool :: String -> Bool -> Bool-assertBool _ = id--testCase :: String -> Bool -> Test-testCase name tst = [(name, runPlainTest)]- where- runPlainTest _ = do- r <- evaluate tst- putStrLn "+++ OK, passed test."- return (r, 1)--defaultMain :: [Test] -> IO ()-defaultMain = runTests . concat--runTests :: [(String, Int -> IO (Bool,Int))] -> IO ()-runTests tests = do- x <- getArgs- let n = if null x then 100 else read . head $ x- (results, passed) <- liftM unzip $ mapM (\(s,a) -> printf "%-40s: " s >> a n) tests- _ <- printf "Passed %d tests!\n" (sum passed)- when (not . and $ results) $ fail "Not all tests passed!"
− tests/builder/Data/ByteString/Builder/Prim/TestUtils.hs
@@ -1,377 +0,0 @@-{-# LANGUAGE CPP, 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.Char (chr, ord)--import Numeric (showHex)--#if MIN_VERSION_base(4,4,0)-import Foreign hiding (unsafePerformIO)-import System.IO.Unsafe (unsafePerformIO)-#else-import Foreign-#endif--import System.ByteOrder--#if defined(HAVE_TEST_FRAMEWORK)-import Test.HUnit (assertBool)-import Test.Framework-import Test.Framework.Providers.HUnit-import Test.Framework.Providers.QuickCheck2-#else-import TestFramework-#endif-import Test.QuickCheck (Arbitrary(..))---- 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) -> Test-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- -> Test-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- -> Test-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)- -> Test-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- -> Test-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) -> Test-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 byteOrder of- LittleEndian -> littleEndian_list- BigEndian -> bigEndian_list- _ -> error $- "bounded-encoding: unsupported byteorder '" ++ show byteOrder ++ "'"---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
@@ -1,168 +0,0 @@-{-# LANGUAGE CPP, 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 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 Data.ByteString.Builder-import qualified Data.ByteString.Builder.Prim as BP-import Data.ByteString.Builder.Prim.TestUtils--#if defined(HAVE_TEST_FRAMEWORK)-import Test.Framework-#else-import TestFramework-#endif---tests :: [Test]-tests = concat [ testsBinary, testsASCII, testsChar8, testsUtf8- , testsCombinatorsB ]------------------------------------------------------------------------------------ Binary---------------------------------------------------------------------------------testsBinary :: [Test]-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 :: [Test]-testsChar8 =- [ testBoundedF "char8" char8_list BP.char8 ]------------------------------------------------------------------------------------ ASCII---------------------------------------------------------------------------------testsASCII :: [Test]-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 :: [Test]-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 :: [Test]-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
@@ -1,619 +0,0 @@-{-# LANGUAGE CPP, FlexibleContexts, ScopedTypeVariables, BangPatterns #-}-{-# 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.State-import Control.Monad.Writer--import Foreign (Word, Word8, minusPtr)-import System.IO.Unsafe (unsafePerformIO)--import Data.Char (ord, chr)-import qualified Data.DList as D-import Data.Foldable (asum, foldMap)--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)-import System.IO (hSetEncoding, utf8)-import System.Directory-import Foreign (ForeignPtr, withForeignPtr, castPtr)--#if defined(HAVE_TEST_FRAMEWORK)-import Test.Framework-import Test.Framework.Providers.QuickCheck2-#else-import TestFramework-#endif--import Test.QuickCheck- ( Arbitrary(..), oneof, choose, listOf, elements- , UnicodeString(..) )-import Test.QuickCheck.Property- ( printTestCase, morallyDubiousIOProperty )---tests :: [Test]-tests =- [ testBuilderRecipe- , testHandlePutBuilder- , testHandlePutBuilderChar8- , testPut- , testRunBuilder- ] ++- testsEncodingToBuilder ++- testsBinary ++- testsASCII ++- testsChar8 ++- testsUtf8------------------------------------------------------------------------------------ Testing 'Builder' execution---------------------------------------------------------------------------------testBuilderRecipe :: Test-testBuilderRecipe =- testProperty "toLazyByteStringWith" $ testRecipe <$> arbitrary- where- testRecipe r =- printTestCase 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 :: Test-testHandlePutBuilder =- testProperty "hPutBuilder" testRecipe- where- testRecipe :: (UnicodeString, UnicodeString, UnicodeString, Recipe) -> Bool- testRecipe args =- unsafePerformIO $ 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- tempDir <- getTemporaryDirectory- (tempFile, tempH) <- openTempFile tempDir "TestBuilder"- -- switch to UTF-8 encoding- hSetEncoding tempH utf8- -- 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 $ mconcat- [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 :: Test-testHandlePutBuilderChar8 =- testProperty "char8 hPutBuilder" testRecipe- where- testRecipe :: (String, String, String, Recipe) -> Bool- testRecipe args@(before, between, after, recipe) = unsafePerformIO $ do- tempDir <- getTemporaryDirectory- (tempFile, tempH) <- openTempFile tempDir "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 $ mconcat- [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----- 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 $ execWriter (evalStateT (mapM_ renderAction as) firstSize)- `mappend` renderLBS cont- where- 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 $ mempty- renderAction (EnsureFree _) = tell $ mempty- renderAction (FDec f) = tell $ D.fromList $ encodeASCII $ show f- renderAction (DDec d) = tell $ D.fromList $ encodeASCII $ show d- renderAction (ModState i) = do- s <- get- tell (D.fromList $ encodeASCII $ show s)- 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 (mapM_ 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 :: [Test]-testsEncodingToBuilder =- [ test_encodeUnfoldrF- , test_encodeUnfoldrB- ]----- Unfoldr fused with encoding---------------------------------test_encodeUnfoldrF :: Test-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 :: Test-test_encodeUnfoldrB =- compareImpls "encodeUnfoldrB charUtf8" (concatMap 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 :: Test-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 :: Test-testRunBuilder =- testProperty "runBuilder" prop- where- prop actions =- morallyDubiousIOProperty $ do- let (builder, _) = recipeComponents recipe- expected = renderRecipe recipe- actual <- bufferWriterOutput (runBuilder builder)- return (S.unpack actual == expected)- where- recipe = Recipe Safe 0 0 mempty 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) -> Test-testBuilderConstr name ref mkBuilder =- testProperty name check- where- check x =- (ws ++ ws) ==- (L.unpack $ toLazyByteString $ mkBuilder x `mappend` mkBuilder x)- where- ws = ref x---testsBinary :: [Test]-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 :: [Test]-testsASCII =- [ testBuilderConstr "char7" char7_list char7- , testBuilderConstr "string7" (concatMap 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 :: [Test]-testsChar8 =- [ testBuilderConstr "charChar8" char8_list char8- , testBuilderConstr "stringChar8" (concatMap char8_list) string8- ]--testsUtf8 :: [Test]-testsUtf8 =- [ testBuilderConstr "charUtf8" charUtf8_list charUtf8- , testBuilderConstr "stringUtf8" (concatMap charUtf8_list) stringUtf8- ]
− tests/builder/TestSuite.hs
@@ -1,22 +0,0 @@-{-# LANGUAGE CPP #-}-module Main where--import qualified Data.ByteString.Builder.Tests-import qualified Data.ByteString.Builder.Prim.Tests-#if defined(HAVE_TEST_FRAMEWORK)-import Test.Framework (defaultMain, Test, testGroup)-#else-import TestFramework-#endif--main :: IO ()-main = defaultMain tests--tests :: [Test]-tests =- [ testGroup "Data.ByteString.Builder"- Data.ByteString.Builder.Tests.tests-- , testGroup "Data.ByteString.Lazy.Builder.BasicEncoding"- Data.ByteString.Builder.Prim.Tests.tests- ]