bytestring-0.12.0.0: tests/Properties/ByteString.hs

-- |
-- Module      : Properties.ByteString
-- Copyright   : (c) Andrew Lelechenko 2021
-- License     : BSD-style

{-# LANGUAGE CPP #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- We need @AllowAmbiguousTypes@ in order to be able to use @TypeApplications@
-- to disambiguate the desired instance of class methods whose instance cannot
-- be inferred from the caller's context.  We would otherwise have to use
-- proxy arguments.  Here the 'RdInt' class methods used to generate tests for
-- all the various 'readInt' types require explicit type applications.

-- We are happy to sacrifice optimizations in exchange for faster compilation,
-- but need to test rewrite rules. As one can check using -ddump-rule-firings,
-- rewrite rules do not fire in -O0 mode, so we use -O1, but disable almost all
-- optimizations. It roughly halves compilation time.
{-# OPTIONS_GHC -O1 -fenable-rewrite-rules
  -fmax-simplifier-iterations=1 -fsimplifier-phases=0
  -fno-call-arity -fno-case-merge -fno-cmm-elim-common-blocks -fno-cmm-sink
  -fno-cpr-anal -fno-cse -fno-do-eta-reduction -fno-float-in -fno-full-laziness
  -fno-loopification -fno-specialise -fno-strictness #-}

-- BYTESTRING_CHAR8 and BYTESTRING_LAZY are defined in
-- Properties.ByteString{Char8,Lazy,LazyChar8}, which include this file.
#ifndef BYTESTRING_CHAR8

#if defined(BYTESTRING_SHORT)
module Properties.ShortByteString (tests) where
import qualified Data.ByteString.Short as B
import qualified Data.ByteString.Short.Internal as B
#define BYTESTRING_TYPE B.ShortByteString
#elif !(defined BYTESTRING_LAZY)
module Properties.ByteString (tests) where
#define BYTESTRING_TYPE B.ByteString
import qualified Data.ByteString as B
import GHC.IO.Encoding
#else
module Properties.ByteStringLazy (tests) where
#define BYTESTRING_TYPE B.ByteString
import qualified Data.ByteString.Lazy as B
#endif

#else

#ifndef BYTESTRING_LAZY
module Properties.ByteStringChar8 (tests) where
import qualified Data.ByteString.Char8 as B
#define BYTESTRING_TYPE B.ByteString
#else
module Properties.ByteStringLazyChar8 (tests) where
import qualified Data.ByteString.Lazy.Char8 as B
#define BYTESTRING_TYPE B.ByteString
#endif

import Data.Int
import Numeric.Natural (Natural)

import Text.Read

#endif

import Prelude hiding (head, tail)
import Control.Arrow
import Data.Char
import Data.Foldable
import qualified Data.List as List
import qualified Data.List.NonEmpty as NE
import Data.Semigroup
import Data.String
import Data.Tuple
import Data.Word
import Test.Tasty
import Test.Tasty.QuickCheck
import QuickCheckUtils

#ifndef BYTESTRING_CHAR8
toElem :: Word8 -> Word8
toElem = id
#else
toElem :: Char8 -> Char
toElem (Char8 c) = c

class (Integral a, Show a) => RdInt a where
    bread :: BYTESTRING_TYPE -> Maybe (a, BYTESTRING_TYPE)
    sread :: String -> Maybe (a, String)

instance RdInt Int    where { bread = B.readInt;     sread = readInt }
instance RdInt Int8   where { bread = B.readInt8;    sread = readInt8 }
instance RdInt Int16  where { bread = B.readInt16;   sread = readInt16 }
instance RdInt Int32  where { bread = B.readInt32;   sread = readInt32 }
instance RdInt Int64  where { bread = B.readInt64;   sread = readInt64 }
--
instance RdInt Word   where { bread = B.readWord;    sread = readWord }
instance RdInt Word8  where { bread = B.readWord8;   sread = readWord8 }
instance RdInt Word16 where { bread = B.readWord16;  sread = readWord16 }
instance RdInt Word32 where { bread = B.readWord32;  sread = readWord32 }
instance RdInt Word64 where { bread = B.readWord64;  sread = readWord64 }
--
instance RdInt Integer where { bread = B.readInteger; sread = readInteger }
instance RdInt Natural where { bread = B.readNatural; sread = readNatural }

instance Arbitrary Natural where
    arbitrary = i2n <$> arbitrary
      where i2n :: Integer -> Natural
            i2n i | i >= 0 = fromIntegral i
                  | otherwise = fromIntegral $ negate i

testRdInt :: forall a. (Arbitrary a, RdInt a) => String -> TestTree
testRdInt s = testGroup s $
    [ testProperty "from string" $ \ prefix value suffix ->
        let si = show @a value
            b  = prefix <> B.pack si <> suffix
         in fmap (second B.unpack) (bread @a b)
            === sread @a (B.unpack prefix ++ si ++ B.unpack suffix)
    , testProperty "from number" $ \n ->
        bread @a (B.pack (show n)) === Just (n, B.empty)
    ]
#endif

tests :: [TestTree]
tests =
  [ testProperty "pack . unpack" $
    \x -> x === B.pack (B.unpack x)
  , testProperty "unpack . pack" $
    \(map toElem -> xs) -> xs === B.unpack (B.pack xs)
  , testProperty "read . show" $
    \x -> (x :: BYTESTRING_TYPE) === read (show x)
#ifndef BYTESTRING_SHORT
  , testProperty "fromStrict . toStrict" $
    \x -> B.fromStrict (B.toStrict x) === x
  , testProperty "toStrict . fromStrict" $
    \x -> B.toStrict (B.fromStrict x) === x
#endif
#if !defined(BYTESTRING_LAZY) && !defined(BYTESTRING_CHAR8) && !defined(BYTESTRING_SHORT)
  , testProperty "toFilePath >>= fromFilePath" $
    \x -> ioProperty $ do
      r <- B.toFilePath x >>= B.fromFilePath
      pure (r === x)
  , testProperty "fromFilePath >>= toFilePath" $ ioProperty $ do
    let prop x = ioProperty $ do
          r <- B.fromFilePath x >>= B.toFilePath
          pure (r === x)
    -- Normally getFileSystemEncoding returns a Unicode encoding,
    -- but if it is ASCII, we should not generate Unicode filenames.
    enc <- getFileSystemEncoding
    pure $ case textEncodingName enc of
      "ASCII"          -> property (prop . getASCIIString)
      "ANSI_X3.4-1968" -> property (prop . getASCIIString)
      _                -> property prop
#endif

  , testProperty "==" $
    \x y -> (x == y) === (B.unpack x == B.unpack y)
  , testProperty "== refl" $
    \x -> (x :: BYTESTRING_TYPE) == x
  , testProperty "== symm" $
    \x y -> ((x :: BYTESTRING_TYPE) == y) === (y == x)
  , testProperty "== pack unpack" $
    \x -> x == B.pack (B.unpack x)
#ifndef BYTESTRING_SHORT
  , testProperty "== copy" $
    \x -> x == B.copy x
#endif

  , testProperty "compare" $
    \x y -> compare x y === compare (B.unpack x) (B.unpack y)
  , testProperty "compare EQ" $
    \x -> compare (x :: BYTESTRING_TYPE) x == EQ
  , testProperty "compare GT" $
    \x (toElem -> c) -> compare (B.snoc x c) x == GT
  , testProperty "compare LT" $
    \x (toElem -> c) -> compare x (B.snoc x c) == LT
  , testProperty "compare GT empty" $
    \x -> not (B.null x) ==> compare x B.empty == GT
  , testProperty "compare LT empty" $
    \x -> not (B.null x) ==> compare B.empty x == LT
  , testProperty "compare GT concat" $
    \x y -> not (B.null y) ==> compare (x <> y) x == GT
  , testProperty "compare char" $
    \(toElem -> c) (toElem -> d) -> compare c d == compare (B.singleton c) (B.singleton d)
#ifndef BYTESTRING_CHAR8
  , testProperty "compare unsigned" $ once $
    compare (B.singleton 255) (B.singleton 127) == GT
#endif

  , testProperty "null" $
    \x -> B.null x === null (B.unpack x)
  , testProperty "empty 0" $ once $
    B.length B.empty === 0
  , testProperty "empty []" $ once $
    B.unpack B.empty === []
  , testProperty "mempty 0" $ once $
    B.length mempty === 0
  , testProperty "mempty []" $ once $
    B.unpack mempty === []

  , testProperty "concat" $
    \(Sqrt xs) -> B.unpack (B.concat xs) === concat (map B.unpack xs)
  , testProperty "concat [x,x]" $
    \x -> B.unpack (B.concat [x, x]) === concat [B.unpack x, B.unpack x]
  , testProperty "concat [x,[]]" $
    \x -> B.unpack (B.concat [x, B.empty]) === concat [B.unpack x, []]
  , testProperty "mconcat" $
    \(Sqrt xs) -> B.unpack (mconcat xs) === mconcat (map B.unpack xs)
  , testProperty "mconcat [x,x]" $
    \x -> B.unpack (mconcat [x, x]) === mconcat [B.unpack x, B.unpack x]
  , testProperty "mconcat [x,[]]" $
    \x -> B.unpack (mconcat [x, B.empty]) === mconcat [B.unpack x, []]

  , testProperty "null" $
    \x -> B.null x === null (B.unpack x)
  , testProperty "reverse" $
    \x -> B.unpack (B.reverse x) === reverse (B.unpack x)
#ifndef BYTESTRING_SHORT
  , testProperty "transpose" $
    \xs -> map B.unpack (B.transpose xs) === List.transpose (map B.unpack xs)
  , testProperty "group" $
    \x -> map B.unpack (B.group x) === List.group (B.unpack x)
  , testProperty "groupBy" $
    \f x -> map B.unpack (B.groupBy f x) === List.groupBy f (B.unpack x)
  , testProperty "groupBy ==" $
    \x -> map B.unpack (B.groupBy (==) x) === List.groupBy (==) (B.unpack x)
  , testProperty "groupBy /=" $
    \x -> map B.unpack (B.groupBy (/=) x) === List.groupBy (/=) (B.unpack x)
  , testProperty "inits" $
    \x -> map B.unpack (B.inits x) === List.inits (B.unpack x)
  , testProperty "tails" $
    \x -> map B.unpack (B.tails x) === List.tails (B.unpack x)
  , testProperty "initsNE" $
    \x -> NE.map B.unpack (B.initsNE x) === NE.inits (B.unpack x)
  , testProperty "tailsNE" $
    \x -> NE.map B.unpack (B.tailsNE x) === NE.tails (B.unpack x)
#endif
  , testProperty "all" $
    \f x -> B.all f x === all f (B.unpack x)
  , testProperty "all ==" $
    \(toElem -> c) x -> B.all (== c) x === all (== c) (B.unpack x)
  , testProperty "any" $
    \f x -> B.any f x === any f (B.unpack x)
  , testProperty "any ==" $
    \(toElem -> c) x -> B.any (== c) x === any (== c) (B.unpack x)
  , testProperty "append" $
    \x y -> B.unpack (B.append x y) === B.unpack x ++ B.unpack y
  , testProperty "mappend" $
    \x y -> B.unpack (mappend x y) === B.unpack x `mappend` B.unpack y
  , testProperty "<>" $
    \x y -> B.unpack (x <> y) === B.unpack x <> B.unpack y
#ifndef BYTESTRING_SHORT
  , testProperty "stimes" $
    \(Sqrt (NonNegative n)) (Sqrt x) -> stimes (n :: Int) (x :: BYTESTRING_TYPE) === mtimesDefault n x
#endif

  , testProperty "break" $
    \f x -> (B.unpack *** B.unpack) (B.break f x) === break f (B.unpack x)
  , testProperty "break ==" $
    \(toElem -> c) x -> (B.unpack *** B.unpack) (B.break (== c) x) === break (== c) (B.unpack x)
  , testProperty "break /=" $
    \(toElem -> c) x -> (B.unpack *** B.unpack) (B.break (/= c) x) === break (/= c) (B.unpack x)
  , testProperty "break span" $
    \f x -> B.break f x === B.span (not . f) x
  , testProperty "breakEnd" $
    \f x -> B.breakEnd f x === swap ((B.reverse *** B.reverse) (B.break f (B.reverse x)))
  , testProperty "breakEnd" $
    \f x -> B.breakEnd f x === B.spanEnd (not . f) x

#ifndef BYTESTRING_LAZY
  , testProperty "break breakSubstring" $
    \(toElem -> c) x -> B.break (== c) x === B.breakSubstring (B.singleton c) x
  , testProperty "breakSubstring" $
    \x y -> not (B.null x) ==> B.null (snd (B.breakSubstring x y)) === not (B.isInfixOf x y)
  , testProperty "breakSubstring empty" $
    \x -> B.breakSubstring B.empty x === (B.empty, x)
#endif
#ifdef BYTESTRING_CHAR8
  , testProperty "break isSpace" $
    \x -> (B.unpack *** B.unpack) (B.break isSpace x) === break isSpace (B.unpack x)
#endif

#ifndef BYTESTRING_SHORT
  , testProperty "concatMap" $
    \f x -> B.unpack (B.concatMap f x) === concatMap (B.unpack . f) (B.unpack x)
  , testProperty "concatMap singleton" $
    \x -> B.unpack (B.concatMap B.singleton x) === concatMap (: []) (B.unpack x)
#endif

  , testProperty "singleton" $
    \(toElem -> c) -> B.unpack (B.singleton c) === [c]
  , testProperty "cons" $
    \(toElem -> c) x -> B.unpack (B.cons c x) === c : B.unpack x
  , testProperty "cons []" $
    \(toElem -> c) -> B.unpack (B.cons c B.empty) === [c]
  , testProperty "uncons" $
    \x -> fmap (second B.unpack) (B.uncons x) === List.uncons (B.unpack x)
  , testProperty "snoc" $
    \(toElem -> c) x -> B.unpack (B.snoc x c) === B.unpack x ++ [c]
  , testProperty "snoc []" $
    \(toElem -> c) -> B.unpack (B.snoc B.empty c) === [c]
  , testProperty "unsnoc" $
    \x -> fmap (first B.unpack) (B.unsnoc x) === unsnoc (B.unpack x)
#ifdef BYTESTRING_LAZY
  , testProperty "cons'" $
    \(toElem -> c) x -> B.unpack (B.cons' c x) === c : B.unpack x
#endif

  , testProperty "drop" $
    \n x -> B.unpack (B.drop n x) === List.genericDrop n (B.unpack x)
  , testProperty "drop 10" $
    \x -> let n = 10 in B.unpack (B.drop n x) === List.genericDrop n (B.unpack x)
  , testProperty "drop 2^31" $
    \x -> let n = 2^31 in B.unpack (B.drop n x) === List.genericDrop n (B.unpack x)
  , testProperty "dropWhile" $
    \f x -> B.unpack (B.dropWhile f x) === dropWhile f (B.unpack x)
  , testProperty "dropWhile ==" $
    \(toElem -> c) x -> B.unpack (B.dropWhile (== c) x) === dropWhile (== c) (B.unpack x)
  , testProperty "dropWhile /=" $
    \(toElem -> c) x -> B.unpack (B.dropWhile (/= c) x) === dropWhile (/= c) (B.unpack x)
#ifdef BYTESTRING_CHAR8
  , testProperty "dropWhile isSpace" $
    \x -> B.unpack (B.dropWhile isSpace x) === dropWhile isSpace (B.unpack x)
#endif

  , testProperty "take" $
    \n x -> B.unpack (B.take n x) === List.genericTake n (B.unpack x)
  , testProperty "take 10" $
    \x -> let n = 10 in B.unpack (B.take n x) === List.genericTake n (B.unpack x)
  , testProperty "take 2^31" $
    \x -> let n = 2^31 in B.unpack (B.take n x) === List.genericTake n (B.unpack x)
  , testProperty "takeWhile" $
    \f x -> B.unpack (B.takeWhile f x) === takeWhile f (B.unpack x)
  , testProperty "takeWhile ==" $
    \(toElem -> c) x -> B.unpack (B.takeWhile (== c) x) === takeWhile (== c) (B.unpack x)
  , testProperty "takeWhile /=" $
    \(toElem -> c) x -> B.unpack (B.takeWhile (/= c) x) === takeWhile (/= c) (B.unpack x)
#ifdef BYTESTRING_CHAR8
  , testProperty "takeWhile isSpace" $
    \x -> B.unpack (B.takeWhile isSpace x) === takeWhile isSpace (B.unpack x)
#endif

  , testProperty "dropEnd" $
    \n x -> B.dropEnd n x === B.take (B.length x - n) x
  , testProperty "dropWhileEnd" $
    \f x -> B.dropWhileEnd f x === B.reverse (B.dropWhile f (B.reverse x))
  , testProperty "takeEnd" $
    \n x -> B.takeEnd n x === B.drop (B.length x - n) x
  , testProperty "takeWhileEnd" $
    \f x -> B.takeWhileEnd f x === B.reverse (B.takeWhile f (B.reverse x))

#ifdef BYTESTRING_LAZY
  , testProperty "fromChunks . toChunks" $
    \x -> B.fromChunks (B.toChunks x) === x
  , testProperty "toChunks . fromChunks" $
    \xs -> B.toChunks (B.fromChunks xs) === filter (/= mempty) xs
  , testProperty "append lazy" $
    \(toElem -> c) -> B.head (B.singleton c <> undefined) === c
  , testProperty "compareLength 1" $
    \x -> B.compareLength x (B.length x) === EQ
  , testProperty "compareLength 2" $
    \x (toElem -> c) -> B.compareLength (B.snoc x c) (B.length x) === GT
  , testProperty "compareLength 3" $
    \x -> B.compareLength x (B.length x + 1) === LT
  , testProperty "compareLength 4" $
    \x (toElem -> c) -> B.compareLength (B.snoc x c <> undefined) (B.length x) === GT
  , testProperty "compareLength 5" $
    \x n -> B.compareLength x n === compare (B.length x) n
  , testProperty "dropEnd lazy" $
    \(toElem -> c) -> B.take 1 (B.dropEnd 1 (B.singleton c <> B.singleton c <> B.singleton c <> undefined)) === B.singleton c
  , testProperty "dropWhileEnd lazy" $
    \(toElem -> c) -> B.take 1 (B.dropWhileEnd (const False) (B.singleton c <> undefined)) === B.singleton c
  , testProperty "breakEnd lazy" $
    \(toElem -> c) -> B.take 1 (fst $ B.breakEnd (const True) (B.singleton c <> undefined)) === B.singleton c
  , testProperty "spanEnd lazy" $
    \(toElem -> c) -> B.take 1 (fst $ B.spanEnd (const False) (B.singleton c <> undefined)) === B.singleton c
#endif

  , testProperty "length" $
    \x -> B.length x === fromIntegral (length (B.unpack x))
  , testProperty "count" $
    \(toElem -> c) x -> B.count c x === fromIntegral (length (List.elemIndices c (B.unpack x)))
  -- for long strings, the multiplier is non-round (and not power of 2)
  -- to ensure non-trivial prefix or suffix of the string is handled outside any possible SIMD-based loop,
  -- which typically handles chunks of 16 or 32 or 64 etc bytes.
  , testProperty "count (long strings)" $
    \(toElem -> c) x (Positive n) -> B.count c x * fromIntegral n === B.count c (B.concat $ replicate n x)
  , testProperty "filter" $
    \f x -> B.unpack (B.filter f x) === filter f (B.unpack x)
  , testProperty "filter compose" $
    \f g x -> B.filter f (B.filter g x) === B.filter (\c -> f c && g c) x
  , testProperty "filter ==" $
    \(toElem -> c) x -> B.unpack (B.filter (== c) x) === filter (== c) (B.unpack x)
  , testProperty "filter /=" $
    \(toElem -> c) x -> B.unpack (B.filter (/= c) x) === filter (/= c) (B.unpack x)
  , testProperty "partition" $
    \f x -> (B.unpack *** B.unpack) (B.partition f x) === List.partition f (B.unpack x)

  , testProperty "find" $
    \f x -> B.find f x === find f (B.unpack x)
  , testProperty "findIndex" $
    \f x -> B.findIndex f x === fmap fromIntegral (List.findIndex f (B.unpack x))
#ifndef BYTESTRING_SHORT
  , testProperty "findIndexEnd" $
    \f x -> B.findIndexEnd f x === fmap fromIntegral (findIndexEnd f (B.unpack x))
#endif
  , testProperty "findIndices" $
    \f x -> B.findIndices f x === fmap fromIntegral (List.findIndices f (B.unpack x))
  , testProperty "findIndices ==" $
    \(toElem -> c) x -> B.findIndices (== c) x === fmap fromIntegral (List.findIndices (== c) (B.unpack x))

  , testProperty "elem" $
    \(toElem -> c) x -> B.elem c x === elem c (B.unpack x)
#ifndef BYTESTRING_SHORT
  , testProperty "notElem" $
    \(toElem -> c) x -> B.notElem c x === notElem c (B.unpack x)
#endif
  , testProperty "elemIndex" $
    \(toElem -> c) x -> B.elemIndex c x === fmap fromIntegral (List.elemIndex c (B.unpack x))
#ifndef BYTESTRING_SHORT
  , testProperty "elemIndexEnd" $
    \(toElem -> c) x -> B.elemIndexEnd c x === fmap fromIntegral (elemIndexEnd c (B.unpack x))
#endif
  , testProperty "elemIndices" $
    \(toElem -> c) x -> B.elemIndices c x === fmap fromIntegral (List.elemIndices c (B.unpack x))

  , testProperty "isPrefixOf" $
    \x y -> B.isPrefixOf x y === List.isPrefixOf (B.unpack x) (B.unpack y)
  , testProperty "stripPrefix" $
    \x y -> fmap B.unpack (B.stripPrefix x y) === List.stripPrefix (B.unpack x) (B.unpack y)
  , testProperty "isSuffixOf" $
    \x y -> B.isSuffixOf x y === List.isSuffixOf (B.unpack x) (B.unpack y)
  , testProperty "stripSuffix" $
    \x y -> fmap B.unpack (B.stripSuffix x y) === stripSuffix (B.unpack x) (B.unpack y)
#ifndef BYTESTRING_LAZY
  , testProperty "isInfixOf" $
    \x y -> B.isInfixOf x y === List.isInfixOf (B.unpack x) (B.unpack y)
#endif

  , testProperty "map" $
    \f x -> B.unpack (B.map (toElem . f) x) === map (toElem . f) (B.unpack x)
  , testProperty "map compose" $
    \f g x -> B.map (toElem . f) (B.map (toElem . g) x) === B.map (toElem . f . toElem . g) x
  , testProperty "replicate" $
    \n (toElem -> c) -> B.unpack (B.replicate (fromIntegral n) c) === replicate n c
  , testProperty "replicate 0" $
    \(toElem -> c) -> B.unpack (B.replicate 0 c) === replicate 0 c

  , testProperty "span" $
    \f x -> (B.unpack *** B.unpack) (B.span f x) === span f (B.unpack x)
  , testProperty "span ==" $
    \(toElem -> c) x -> (B.unpack *** B.unpack) (B.span (== c) x) === span (== c) (B.unpack x)
  , testProperty "span /=" $
    \(toElem -> c) x -> (B.unpack *** B.unpack) (B.span (/= c) x) === span (/= c) (B.unpack x)
  , testProperty "spanEnd" $
    \f x -> B.spanEnd f x === swap ((B.reverse *** B.reverse) (B.span f (B.reverse x)))
  , testProperty "split" $
    \(toElem -> c) x -> map B.unpack (B.split c x) === split c (B.unpack x)
  , testProperty "split empty" $
    \(toElem -> c) -> B.split c B.empty === []
  , testProperty "splitWith" $
    \f x -> map B.unpack (B.splitWith f x) === splitWith f (B.unpack x)
  , testProperty "splitWith split" $
    \(toElem -> c) x -> B.splitWith (== c) x === B.split c x
  , testProperty "splitWith empty" $
    \f -> B.splitWith f B.empty === []
  , testProperty "splitWith length" $
    \f x -> let splits = B.splitWith f x; l1 = fromIntegral (length splits); l2 = B.length (B.filter f x) in
      (l1 == l2 || l1 == l2 + 1) && sum (map B.length splits) + l2 == B.length x

  , testProperty "splitAt" $
    \n x -> (B.unpack *** B.unpack) (B.splitAt n x) === List.genericSplitAt n (B.unpack x)
  , testProperty "splitAt 10" $
    \x -> let n = 10 in (B.unpack *** B.unpack) (B.splitAt n x) === List.genericSplitAt n (B.unpack x)
  , testProperty "splitAt (2^31)" $
    \x -> let n = 2^31 in (B.unpack *** B.unpack) (B.splitAt n x) === List.genericSplitAt n (B.unpack x)

  , testProperty "head" $
    \x -> case B.unpack x of
      []     -> property True
      hd : _ -> B.head x === hd
  , testProperty "last" $
    \x -> not (B.null x) ==> B.last x === last (B.unpack x)
  , testProperty "tail" $
    \x -> case B.unpack x of
      []     -> property True
      _ : tl -> B.unpack (B.tail x) === tl
  , testProperty "tail length" $
    \x -> not (B.null x) ==> B.length x === 1 + B.length (B.tail x)
  , testProperty "init" $
    \x -> not (B.null x) ==> B.unpack (B.init x) === init (B.unpack x)
  , testProperty "init length" $
    \x -> not (B.null x) ==> B.length x === 1 + B.length (B.init x)
#ifndef BYTESTRING_SHORT
  , testProperty "maximum" $
    \x -> not (B.null x) ==> B.maximum x === maximum (B.unpack x)
  , testProperty "minimum" $
    \x -> not (B.null x) ==> B.minimum x === minimum (B.unpack x)
#endif

  , testProperty "foldl" $
    \f (toElem -> c) x -> B.foldl ((toElem .) . f) c x === foldl ((toElem .) . f) c (B.unpack x)
  , testProperty "foldl'" $
    \f (toElem -> c) x -> B.foldl' ((toElem .) . f) c x === foldl' ((toElem .) . f) c (B.unpack x)
  , testProperty "foldr" $
    \f (toElem -> c) x -> B.foldr ((toElem .) . f) c x === foldr ((toElem .) . f) c (B.unpack x)
  , testProperty "foldr'" $
    \f (toElem -> c) x -> B.foldr' ((toElem .) . f) c x === foldr' ((toElem .) . f) c (B.unpack x)

  , testProperty "foldl cons" $
    \x -> B.foldl (flip B.cons) B.empty x === B.reverse x
  , testProperty "foldr cons" $
    \x -> B.foldr B.cons B.empty x === x
  , testProperty "foldl special" $
    \(Sqrt x) (toElem -> c) -> B.unpack (B.foldl (\acc t -> if t == c then acc else B.cons t acc) B.empty x) ===
      foldl (\acc t -> if t == c then acc else t : acc) [] (B.unpack x)
  , testProperty "foldr special" $
    \(Sqrt x) (toElem -> c) -> B.unpack (B.foldr (\t acc -> if t == c then acc else B.cons t acc) B.empty x) ===
      foldr (\t acc -> if t == c then acc else t : acc) [] (B.unpack x)

  , testProperty "foldl1" $
    \f x -> not (B.null x) ==> B.foldl1 ((toElem .) . f) x === foldl1 ((toElem .) . f) (B.unpack x)
  , testProperty "foldl1'" $
    \f x -> not (B.null x) ==> B.foldl1' ((toElem .) . f) x === List.foldl1' ((toElem .) . f) (B.unpack x)
  , testProperty "foldr1" $
    \f x -> not (B.null x) ==> B.foldr1 ((toElem .) . f) x === foldr1 ((toElem .) . f) (B.unpack x)
  , testProperty "foldr1'" $ -- there is not Data.List.foldr1'
    \f x -> not (B.null x) ==> B.foldr1' ((toElem .) . f) x === foldr1 ((toElem .) . f) (B.unpack x)

  , testProperty "foldl1 const" $
    \x -> not (B.null x) ==> B.foldl1 const x === B.head x
  , testProperty "foldl1 flip const" $
    \x -> not (B.null x) ==> B.foldl1 (flip const) x === B.last x
  , testProperty "foldr1 const" $
    \x -> not (B.null x) ==> B.foldr1 const x === B.head x
  , testProperty "foldr1 flip const" $
    \x -> not (B.null x) ==> B.foldr1 (flip const) x === B.last x
  , testProperty "foldl1 max" $
    \x -> not (B.null x) ==> B.foldl1 max x === B.foldl max minBound x
  , testProperty "foldr1 max" $
    \x -> not (B.null x) ==> B.foldr1 max x === B.foldr max minBound x

#ifndef BYTESTRING_SHORT
  , testProperty "scanl" $
    \f (toElem -> c) x -> B.unpack (B.scanl ((toElem .) . f) c x) === scanl ((toElem .) . f) c (B.unpack x)
  , testProperty "scanl foldl" $
    \f (toElem -> c) x -> not (B.null x) ==> B.last (B.scanl ((toElem .) . f) c x) === B.foldl ((toElem .) . f) c x

  , testProperty "scanr" $
    \f (toElem -> c) x -> B.unpack (B.scanr ((toElem .) . f) c x) === scanr ((toElem .) . f) c (B.unpack x)
  , testProperty "scanl1" $
    \f x -> B.unpack (B.scanl1 ((toElem .) . f) x) === scanl1 ((toElem .) . f) (B.unpack x)
  , testProperty "scanl1 empty" $
    \f -> B.scanl1 f B.empty === B.empty
  , testProperty "scanr1" $
    \f x -> B.unpack (B.scanr1 ((toElem .) . f) x) === scanr1 ((toElem .) . f) (B.unpack x)
  , testProperty "scanr1 empty" $
    \f -> B.scanr1 f B.empty === B.empty
#endif

#if !defined(BYTESTRING_LAZY) && !defined(BYTESTRING_SHORT)
  , testProperty "sort" $
    \x -> B.unpack (B.sort x) === List.sort (B.unpack x)
#endif

#ifndef BYTESTRING_SHORT
  , testProperty "intersperse" $
    \(toElem -> c) x -> B.unpack (B.intersperse c x) === List.intersperse c (B.unpack x)
#endif
  , testProperty "intercalate" $
    \(Sqrt x) (Sqrt ys) -> B.unpack (B.intercalate x ys) === List.intercalate (B.unpack x) (map B.unpack ys)
  , testProperty "intercalate 'c' [x,y]" $
    \(toElem -> c) x y -> B.unpack (B.intercalate (B.singleton c) [x, y]) === List.intercalate [c] [B.unpack x, B.unpack y]
  , testProperty "intercalate split" $
    \(toElem -> c) x -> B.intercalate (B.singleton c) (B.split c x) === x

#ifndef BYTESTRING_SHORT
  , testProperty "mapAccumL" $
    \f (toElem -> c) x -> second B.unpack (B.mapAccumL ((second toElem .) . f) c x) ===
      List.mapAccumL ((second toElem .) . f) c (B.unpack x)
  , testProperty "mapAccumR" $
    \f (toElem -> c) x -> second B.unpack (B.mapAccumR ((second toElem .) . f) c x) ===
      List.mapAccumR ((second toElem .) . f) c (B.unpack x)

  , testProperty "zip" $
    \x y -> B.zip x y === zip (B.unpack x) (B.unpack y)
  , testProperty "zipWith" $
    \f x y -> (B.zipWith f x y :: [Int]) === zipWith f (B.unpack x) (B.unpack y)
  , testProperty "packZipWith" $
    \f x y -> B.unpack (B.packZipWith ((toElem .) . f) x y) === zipWith ((toElem .) . f) (B.unpack x) (B.unpack y)
  , testProperty "unzip" $
    \(fmap (toElem *** toElem) -> xs) -> (B.unpack *** B.unpack) (B.unzip xs) === unzip xs
#endif

  , testProperty "index" $
    \(NonNegative n) x -> fromIntegral n < B.length x ==> B.index x (fromIntegral n) === B.unpack x !! n
  , testProperty "indexMaybe" $
    \(NonNegative n) x -> fromIntegral n < B.length x ==> B.indexMaybe x (fromIntegral n) === Just (B.unpack x !! n)
  , testProperty "indexMaybe Nothing" $
    \n x -> (n :: Int) < 0 || fromIntegral n >= B.length x ==> B.indexMaybe x (fromIntegral n) === Nothing
  , testProperty "!?" $
    \n x -> B.indexMaybe x (fromIntegral (n :: Int)) === x B.!? (fromIntegral n)

#ifdef BYTESTRING_CHAR8
  , testProperty "isString" $
    \x -> x === fromString (B.unpack x)
  , testRdInt @Int    "readInt"
  , testRdInt @Int8   "readInt8"
  , testRdInt @Int16  "readInt16"
  , testRdInt @Int32  "readInt32"
  , testRdInt @Int64  "readInt64"
  , testRdInt @Word   "readWord"
  , testRdInt @Word8  "readWord8"
  , testRdInt @Word16 "readWord16"
  , testRdInt @Word32 "readWord32"
  , testRdInt @Word64 "readWord64"
  , testRdInt @Integer "readInteger"
  , testRdInt @Natural "readNatural"
  , testProperty "lines" $
    \x -> map B.unpack (B.lines x) === lines (B.unpack x)
  , testProperty "lines \\n" $ once $
    let x = B.pack "one\ntwo\n\n\nfive\n\nseven\n" in
    map B.unpack (B.lines x) === lines (B.unpack x)
  , testProperty "unlines" $
    \xs -> B.unpack (B.unlines xs) === unlines (map B.unpack xs)
  , testProperty "words" $
    \x -> map B.unpack (B.words x) === words (B.unpack x)
  , testProperty "unwords" $
    \xs -> B.unpack (B.unwords xs) === unwords (map B.unpack xs)
#endif

#ifndef BYTESTRING_LAZY
  , testProperty "unfoldrN" $
    \n f (toElem -> c) -> B.unpack (fst (B.unfoldrN n (fmap (first toElem) . f) c)) ===
      take (fromIntegral n) (List.unfoldr (fmap (first toElem) . f) c)
  , testProperty "unfoldrN replicate" $
    \n (toElem -> c) -> fst (B.unfoldrN n (\t -> Just (t, t)) c) === B.replicate n c
  , testProperty "unfoldr" $
    \n a (toElem -> c) -> B.unpack (B.unfoldr (\x -> if x <= 100 * n then Just (c, x + 1 :: Int) else Nothing) a) ===
      List.unfoldr (\x -> if x <= 100 * n then Just (c, x + 1) else Nothing) a
#endif

#ifdef BYTESTRING_LAZY
  , testProperty "unfoldr" $
    \n f (toElem -> a) -> B.unpack (B.take (fromIntegral n) (B.unfoldr (fmap (first toElem) . f) a)) ===
      take n (List.unfoldr (fmap (first toElem) . f) a)
  , testProperty "repeat" $
    \n (toElem -> c) -> B.take (fromIntegral (n :: Int)) (B.repeat c) ===
      B.take (fromIntegral n) (B.unfoldr (\a -> Just (a, a)) c)
  , testProperty "cycle" $
    \n x -> not (B.null x) ==> B.take (fromIntegral (n :: Int)) (B.cycle x) ===
      B.take (fromIntegral n) (B.concat (List.unfoldr (\a -> Just (a, a)) x))
  , testProperty "iterate" $
    \n f (toElem -> a) -> B.take (fromIntegral (n :: Int)) (B.iterate (toElem . f) a) ===
      B.take (fromIntegral n) (B.unfoldr (\x -> Just (toElem (f x), toElem (f x))) a)
#endif

#ifndef BYTESTRING_CHAR8
  -- issue #393
  , testProperty "fromString non-char8" $
    \s -> fromString s == B.pack (map (fromIntegral . ord :: Char -> Word8) s)
  , testProperty "fromString literal" $
    fromString "\0\1\2\3\4" == B.pack [0,1,2,3,4]
#endif
  ]

unsnoc :: [a] -> Maybe ([a], a)
unsnoc [] = Nothing
unsnoc xs = Just (init xs, last xs)

#ifndef BYTESTRING_SHORT
findIndexEnd :: (a -> Bool) -> [a] -> Maybe Int
findIndexEnd f xs = fmap (\n -> length xs - 1 - n) (List.findIndex f (reverse xs))

elemIndexEnd :: Eq a => a -> [a] -> Maybe Int
elemIndexEnd c xs = fmap (\n -> length xs - 1 - n) (List.elemIndex c (reverse xs))
#endif

stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]
stripSuffix x y = fmap reverse (List.stripPrefix (reverse x) (reverse y))

split :: Eq a => a -> [a] -> [[a]]
split c = splitWith (== c)

splitWith :: (a -> Bool) -> [a] -> [[a]]
splitWith _ [] = []
splitWith f ys = go [] ys
  where
    go acc [] = [reverse acc]
    go acc (x : xs)
      | f x       = reverse acc : go [] xs
      | otherwise = go (x : acc) xs

#ifdef BYTESTRING_CHAR8
readInt :: String -> Maybe (Int, String)
readInt xs = case readInteger xs of
  Just (y, zs)
    | y' <- fromInteger y, toInteger y' == y -> Just (y', zs)
  otherwise -> Nothing

readWord :: String -> Maybe (Word, String)
readWord xs = case readIntegerUnsigned xs of
  Just (y, zs)
    | y' <- fromInteger y, toInteger y' == y -> Just (y', zs)
  otherwise -> Nothing

readInt8 :: String -> Maybe (Int8, String)
readInt8 xs = case readInteger xs of
  Just (y, zs)
    | y' <- fromInteger y, toInteger y' == y -> Just (y', zs)
  otherwise -> Nothing

readWord8 :: String -> Maybe (Word8, String)
readWord8 xs = case readIntegerUnsigned xs of
  Just (y, zs)
    | y' <- fromInteger y, toInteger y' == y -> Just (y', zs)
  otherwise -> Nothing

readInt16 :: String -> Maybe (Int16, String)
readInt16 xs = case readInteger xs of
  Just (y, zs)
    | y' <- fromInteger y, toInteger y' == y -> Just (y', zs)
  otherwise -> Nothing

readWord16 :: String -> Maybe (Word16, String)
readWord16 xs = case readIntegerUnsigned xs of
  Just (y, zs)
    | y' <- fromInteger y, toInteger y' == y -> Just (y', zs)
  otherwise -> Nothing

readInt32 :: String -> Maybe (Int32, String)
readInt32 xs = case readInteger xs of
  Just (y, zs)
    | y' <- fromInteger y, toInteger y' == y -> Just (y', zs)
  otherwise -> Nothing

readWord32 :: String -> Maybe (Word32, String)
readWord32 xs = case readIntegerUnsigned xs of
  Just (y, zs)
    | y' <- fromInteger y, toInteger y' == y -> Just (y', zs)
  otherwise -> Nothing

readInt64 :: String -> Maybe (Int64, String)
readInt64 xs = case readInteger xs of
  Just (y, zs)
    | y' <- fromInteger y, toInteger y' == y -> Just (y', zs)
  otherwise -> Nothing

readWord64 :: String -> Maybe (Word64, String)
readWord64 xs = case readIntegerUnsigned xs of
  Just (y, zs)
    | y' <- fromInteger y, toInteger y' == y -> Just (y', zs)
  otherwise -> Nothing

readInteger :: String -> Maybe (Integer, String)
readInteger ('+' : xs) = readIntegerUnsigned xs
readInteger ('-' : xs) = fmap (first negate) (readIntegerUnsigned xs)
readInteger xs = readIntegerUnsigned xs

readNatural :: String -> Maybe (Natural, String)
readNatural xs = case readIntegerUnsigned xs of
  Just (y, zs)
    | y >= 0 -> Just (fromIntegral @Integer @Natural y, zs)
  _          -> Nothing

readIntegerUnsigned :: String -> Maybe (Integer, String)
readIntegerUnsigned xs = case readMaybe ys of
  Just y -> Just (y, zs)
  otherwise -> Nothing
  where
    (ys, zs) = span isDigit xs
#endif