content: {-# LANGUAGE CPP #-}
  
  module Tests.Vector
    ( vectorTests
    ) where
  
  import Support
  
  import Prelude hiding (and, or)
  import Control.Exception
  import Data.Bit
  import Data.Bits
  import Data.List (findIndex)
  import qualified Data.Vector.Primitive as P
  import qualified Data.Vector.Unboxed as U
  import qualified Data.Vector.Unboxed.Base as UB
  import Data.Word
  import Test.Tasty
  import Test.Tasty.QuickCheck (Property, NonNegative(..), Positive(..), testProperty, Large(..), (===), property, once, (==>), ioProperty, (.&&.), counterexample)
  
  #include "MachDeps.h"
  
  vectorTests :: TestTree
  vectorTests = testGroup "Data.Vector.Unboxed.Bit"
    [ testGroup "Data.Vector.Unboxed functions"
      [ testProperty "toList . fromList == id" prop_toList_fromList
      , mkGroup      "fromList . toList == id" prop_fromList_toList
      , testProperty "slice"                   prop_slice_def
      ]
    , tenTimesLess $
      testProperty "cloneFromWords" prop_cloneFromWords_def
    , mkGroup      "cloneToWords"   prop_cloneToWords_def
    , tenTimesLess $
      testProperty "castToWords_1"   prop_castToWords_1
    , tenTimesLess $
      testProperty "castToWords_2"   prop_castToWords_2
    , tenTimesLess $
      testProperty "cloneFromWords8" prop_cloneFromWords8_def
    , mkGroup      "cloneToWords8"   prop_cloneToWords8_def
    , tenTimesLess $
      testProperty "castToWords8_1"  prop_castToWords8_1
    , tenTimesLess $
      testProperty "castToWords8_2"  prop_castToWords8_2
    , testProperty "cloneToByteString" prop_cloneToByteString
    , mkGroup "reverse"        prop_reverse_def
    , testGroup "countBits"
      [ testProperty "special case 1" case_countBits_1
      , mkGroup "matches definition"  prop_countBits_def
      ]
    , testGroup "listBits"
      [ testProperty "special case 1" case_listBits_1
      , testProperty "special case 2" case_listBits_2
      , mkGroup "matches definition"  prop_listBits_def
      ]
    , mkGroup "and"            prop_and_def
    , mkGroup "or"             prop_or_def
    , testGroup "bitIndex"
      [ testProperty "special case 1" case_bitIndex_1
      , testProperty "special case 2" case_bitIndex_2
      , testProperty "special case 3" case_bitIndex_3
      , testProperty "special case 4" case_bitIndex_4
      , testProperty "special case 5" case_bitIndex_5
      , testProperty "special case 6" case_bitIndex_6
      , testProperty "special case 7" case_bitIndex_7
      , mkGroup "True"               (prop_bitIndex_1 (Bit True))
      , mkGroup "False"              (prop_bitIndex_1 (Bit False))
      ]
    , testGroup "nthBitIndex"
      [ testProperty "special case 1"                     case_nthBit_1
      , testProperty "special case 2"                     case_nthBit_2
      , testProperty "special case 3"                     case_nthBit_3
      , testProperty "special case 4"                     case_nthBit_4
      , testProperty "special case 5"                     case_nthBit_5
      , testProperty "special case 6"                     case_nthBit_6
      , testProperty "special case 7"                     case_nthBit_7
      , mkGroup      "matches bitIndex True"              prop_nthBit_1
      , mkGroup      "matches bitIndex False"             prop_nthBit_2
      , testProperty "matches sequence of bitIndex True"  prop_nthBit_3
      , testProperty "matches sequence of bitIndex False" prop_nthBit_4
      , testProperty "matches countBits"                  prop_nthBit_5
      , testProperty "negative argument"                  prop_nthBit_6
      ]
    , testGroup "Bits instance"
      [ testProperty "rotate is reversible" prop_rotate
      , testProperty "bit"                  prop_bit
      , testProperty "shiftL"               prop_shiftL
      , testProperty "shiftR"               prop_shiftR
      , testProperty "zeroBits"             prop_zeroBits
      , testProperty "bitSize"              prop_bitSize
      , testProperty "isSigned"             prop_isSigned
      , testProperty "setBit"               prop_setBit
      , testProperty "clearBit"             prop_clearBit
      , testProperty "complementBit"        prop_complementBit
      ]
    ]
  
  mkGroup :: String -> (U.Vector Bit -> Property) -> TestTree
  mkGroup name prop = testGroup name
    [ testProperty "simple" prop
    , testProperty "simple_long" (prop . getLarge)
    , testProperty "middle" propMiddle
    , testProperty "middle_long" propMiddleLong
    ]
    where
      f m = let n = fromIntegral m :: Double in
        odd (truncate (exp (abs (sin n) * 10)) :: Integer)
      propMiddle (NonNegative from) (NonNegative len) (NonNegative excess) =
        prop (U.slice from len (U.generate (from + len + excess) (Bit . f)))
      propMiddleLong (NonNegative x) (NonNegative y) (NonNegative z) =
        propMiddle (NonNegative $ x * 31) (NonNegative $ y * 37) (NonNegative $ z * 29)
  
  prop_toList_fromList :: [Bit] -> Property
  prop_toList_fromList xs = U.toList (U.fromList xs) === xs
  
  prop_fromList_toList :: U.Vector Bit -> Property
  prop_fromList_toList xs = U.fromList (U.toList xs) === xs
  
  prop_slice_def :: Int -> Int -> U.Vector Bit -> Property
  prop_slice_def s n xs =
    sliceList s' n' (U.toList xs) === U.toList (U.slice s' n' xs)
    where
      (s', n') = trimSlice s n (U.length xs)
  
  prop_cloneFromWords_def :: U.Vector Word -> Property
  prop_cloneFromWords_def ws =
    U.toList (castFromWords ws) === concatMap wordToBitList (U.toList ws)
  
  prop_cloneToWords_def :: U.Vector Bit -> Property
  prop_cloneToWords_def xs = U.toList (cloneToWords xs) === loop (U.toList xs)
   where
    loop [] = []
    loop bs = case packBitsToWord bs of
      (w, bs') -> w : loop bs'
  
  prop_castToWords_1 :: U.Vector Word -> Property
  prop_castToWords_1 ws =
    Just ws === castToWords (castFromWords ws)
  
  prop_castToWords_2 :: U.Vector Bit -> Property
  prop_castToWords_2 xs = case castToWords xs of
    Nothing -> property True
    Just ws -> castFromWords ws === xs
  
  prop_cloneFromWords8_def :: U.Vector Word8 -> Property
  prop_cloneFromWords8_def ws
    = counterexample ("offset = " ++ show off ++ " len = " ++ show len)
    $ U.toList (castFromWords8 ws) === concatMap wordToBitList (U.toList ws)
    where
      UB.V_Word8 (P.Vector off len _) = ws
  
  prop_cloneToWords8_def :: U.Vector Bit -> Property
  prop_cloneToWords8_def xs@(BitVec off len _)
    = counterexample ("offset = " ++ show off ++ " len = " ++ show len)
    $ U.toList (cloneToWords8 xs) === loop (U.toList xs)
    where
      loop [] = []
      loop bs = case packBitsToWord bs of
        (w, bs') -> w : loop bs'
  
  prop_castToWords8_1 :: U.Vector Word8 -> Property
  #ifdef WORDS_BIGENDIAN
  prop_castToWords8_1 ws = Nothing === castToWords8 (castFromWords8 ws)
  #else
  prop_castToWords8_1 ws
    = counterexample ("offset = " ++ show off ++ " len = " ++ show len)
    $ Just ws === castToWords8 (castFromWords8 ws)
    where
      UB.V_Word8 (P.Vector off len _) = ws
  #endif
  
  prop_castToWords8_2 :: U.Vector Bit -> Property
  prop_castToWords8_2 xs = case castToWords8 xs of
    Nothing -> property True
    Just ws -> castFromWords8 ws === xs
  
  prop_reverse_def :: U.Vector Bit -> Property
  prop_reverse_def xs =
    reverse (U.toList xs) === U.toList (U.modify reverseInPlace xs)
  
  prop_countBits_def :: U.Vector Bit -> Property
  prop_countBits_def xs = countBits xs === length (filter unBit (U.toList xs))
  
  case_countBits_1 :: Property
  case_countBits_1 = once $
    countBits (U.drop 64 (U.replicate 128 (Bit False))) === 0
  
  prop_listBits_def :: U.Vector Bit -> Property
  prop_listBits_def xs =
    listBits xs === [ i | (i, x) <- zip [0 ..] (U.toList xs), unBit x ]
  
  case_listBits_1 :: Property
  case_listBits_1 = once $
    listBits (U.drop 24 (U.replicate 64 (Bit False))) === []
  
  case_listBits_2 :: Property
  case_listBits_2 = once $
    listBits (U.drop 24 (U.replicate 128 (Bit True))) === [0..103]
  
  and :: U.Vector Bit -> Bool
  and xs = case bitIndex (Bit False) xs of
    Nothing -> True
    Just{}  -> False
  
  prop_and_def :: U.Vector Bit -> Property
  prop_and_def xs = and xs === all unBit (U.toList xs)
  
  or :: U.Vector Bit -> Bool
  or xs = case bitIndex (Bit True) xs of
    Nothing -> False
    Just{}  -> True
  
  prop_or_def :: U.Vector Bit -> Property
  prop_or_def xs = or xs === any unBit (U.toList xs)
  
  case_bitIndex_1 :: Property
  case_bitIndex_1 = once $
    bitIndex (Bit True) (U.generate 128 (Bit . (== 64))) === Just 64
  
  case_bitIndex_2 :: Property
  case_bitIndex_2 = once $
    bitIndex (Bit False) (U.generate 128 (Bit . (/= 64))) === Just 64
  
  case_bitIndex_3 :: Property
  case_bitIndex_3 = once $
    bitIndex (Bit True) (U.drop 63 (U.generate 128 (Bit . (== 64)))) === Just 1
  
  case_bitIndex_4 :: Property
  case_bitIndex_4 = once $
    bitIndex (Bit False) (U.drop 63 (U.generate 128 (Bit . (/= 64)))) === Just 1
  
  case_bitIndex_5 :: Property
  case_bitIndex_5 = once $
    bitIndex (Bit False) (U.drop 63 (U.replicate 65 (Bit True))) === Nothing
  
  case_bitIndex_6 :: Property
  case_bitIndex_6 = once $
    bitIndex (Bit False) (U.drop 63 (U.generate 66 (Bit . (== 63)))) === Just 1
  
  case_bitIndex_7 :: Property
  case_bitIndex_7 = once $
    bitIndex (Bit False) (U.drop 1023 (U.generate 1097 (Bit . (/= 1086)))) === Just 63
  
  prop_bitIndex_1 :: Bit -> U.Vector Bit -> Property
  prop_bitIndex_1 b xs = bitIndex b xs === findIndex (b ==) (U.toList xs)
  
  prop_nthBit_1 :: U.Vector Bit -> Property
  prop_nthBit_1 xs = bitIndex (Bit True) xs === nthBitIndex (Bit True) 1 xs
  
  prop_nthBit_2 :: U.Vector Bit -> Property
  prop_nthBit_2 xs = bitIndex (Bit False) xs === nthBitIndex (Bit False) 1 xs
  
  prop_nthBit_3 :: Positive Int -> U.Vector Bit -> Property
  prop_nthBit_3 (Positive n) xs = case nthBitIndex (Bit True) (n + 1) xs of
    Nothing -> property True
    Just i  -> case bitIndex (Bit True) xs of
      Nothing -> property False
      Just j  -> case nthBitIndex (Bit True) n (U.drop (j + 1) xs) of
        Nothing -> property False
        Just k  -> i === j + k + 1
  
  prop_nthBit_4 :: Positive Int -> U.Vector Bit -> Property
  prop_nthBit_4 (Positive n) xs = case nthBitIndex (Bit False) (n + 1) xs of
    Nothing -> property True
    Just i  -> case bitIndex (Bit False) xs of
      Nothing -> property False
      Just j  -> case nthBitIndex (Bit False) n (U.drop (j + 1) xs) of
        Nothing -> property False
        Just k  -> i === j + k + 1
  
  prop_nthBit_5 :: Positive Int -> U.Vector Bit -> Property
  prop_nthBit_5 (Positive n) xs = count > 0 ==>
    case nthBitIndex (Bit True) n' xs of
      Nothing -> property False
      Just i  -> countBits (U.take (i + 1) xs) === n'
    where
      count = countBits xs
      n' = n `mod` count + 1
  
  prop_nthBit_6 :: NonNegative Int -> U.Vector Bit -> Property
  prop_nthBit_6 (NonNegative n) xs = ioProperty $ do
    ret <- try (evaluate (nthBitIndex (Bit True) (-n) xs))
    pure $ property $ case ret of
      Left ErrorCall{} -> True
      _ -> False
  
  case_nthBit_1 :: Property
  case_nthBit_1 = once $
    nthBitIndex (Bit True) 1 (U.slice 61 4 (U.replicate 100 (Bit False))) === Nothing
  
  case_nthBit_2 :: Property
  case_nthBit_2 = once $
    nthBitIndex (Bit False) 1 (U.slice 61 4 (U.replicate 100 (Bit True))) === Nothing
  
  case_nthBit_3 :: Property
  case_nthBit_3 = once $
    nthBitIndex (Bit True) 1 (U.drop 63 (U.generate 128 (Bit . (== 64)))) === Just 1
  
  case_nthBit_4 :: Property
  case_nthBit_4 = once $
    nthBitIndex (Bit False) 1 (U.drop 63 (U.generate 128 (Bit . (/= 64)))) === Just 1
  
  case_nthBit_5 :: Property
  case_nthBit_5 = once $
    nthBitIndex (Bit False) 1 (U.drop 63 (U.replicate 65 (Bit True))) === Nothing
  
  case_nthBit_6 :: Property
  case_nthBit_6 = once $
    nthBitIndex (Bit False) 1 (U.drop 63 (U.generate 66 (Bit . (== 63)))) === Just 1
  
  case_nthBit_7 :: Property
  case_nthBit_7 = once $
    nthBitIndex (Bit False) 1 (U.drop 1023 (U.generate 1097 (Bit . (/= 1086)))) === Just 63
  
  prop_rotate :: Int -> U.Vector Bit -> Property
  prop_rotate n v = v === (v `rotate` n) `rotate` (-n)
  
  prop_bit :: Int -> Property
  prop_bit n
    | n >= 0
    = testBit v n .&&. popCount v === 1 .&&. U.length v === n + 1
    | otherwise
    = not (testBit v n) .&&. popCount v === 0 .&&. U.length v === 0
    where
      v :: U.Vector Bit
      v = bit n
  
  prop_shiftL :: NonNegative Int -> U.Vector Bit -> Property
  prop_shiftL (NonNegative n) v = v === u
    where
      u = (v `shiftL` n) `shiftR` n
  
  prop_shiftR :: NonNegative Int -> U.Vector Bit -> Property
  prop_shiftR (NonNegative n) v = U.drop n v === U.drop n u .&&. popCount (U.take n u) === 0
    where
      u = (v `shiftR` n) `shiftL` n
  
  prop_zeroBits :: Property
  prop_zeroBits = once $
    U.length (zeroBits :: U.Vector Bit) === 0
  
  prop_bitSize :: U.Vector Bit -> Property
  prop_bitSize v = bitSizeMaybe v === Nothing
  
  prop_isSigned :: U.Vector Bit -> Property
  prop_isSigned v = isSigned v === False
  
  prop_setBit :: Int -> U.Vector Bit -> Property
  prop_setBit n v = v `setBit` n === U.imap ((.|.) . Bit . (== n)) v
  
  prop_clearBit :: Int -> U.Vector Bit -> Property
  prop_clearBit n v = v `clearBit` n === U.imap ((.&.) . Bit . (/= n)) v
  
  prop_complementBit :: Int -> U.Vector Bit -> Property
  prop_complementBit n v = v `complementBit` n === U.imap (xor . Bit . (== n)) v
  
  prop_cloneToByteString :: U.Vector Bit -> Property
  prop_cloneToByteString v@(BitVec off len _)
    = counterexample ("offset = " ++ show off ++ " len = " ++ show len)
    $ cloneToByteString (cloneFromByteString bs) === bs
    where
      bs = cloneToByteString v
  