lzma-enumerator-0.1.1: tests/Main.hs

import Test.Framework (defaultMain, testGroup)
import Test.Framework.Providers.HUnit
import Test.Framework.Providers.QuickCheck2 (testProperty)
import Test.QuickCheck
import Test.QuickCheck.Monadic

import qualified Data.ByteString as B
import qualified Data.Enumerator as E
import qualified Data.Enumerator.List as EL
import Data.List
import Data.Word
import Codec.Compression.Lzma.Enumerator

main = defaultMain tests

tests =
  [ testGroup "Compress" compressTests
  , testGroup "Decompress" decompressTests
  , testGroup "Chained" chainedTests
  ]

compressTests =
  [ testProperty "compressAndDiscard" prop_compressAndDiscard
  , testProperty "compressAndCheckLength" prop_compressAndCheckLength
  ]

decompressTests =
  [ testProperty "decompressRandom" prop_decompressRandom
  , testProperty "decompressCorrupt" prop_decompressCorrupt
  ]

chainedTests =
  [ testProperty "chain" prop_chain
  , testProperty "compressThenDecompress" prop_compressThenDecompress
  ]

someString :: Gen B.ByteString
someString = do
  val <- listOf $ elements [0..255::Word8] 
  return $ B.pack val

someBigString :: Gen B.ByteString
someBigString = resize (8*1024) someString

dropAll :: Monad m => E.Iteratee a m ()
dropAll = EL.dropWhile (const True)

prop_compressAndDiscard :: Property
prop_compressAndDiscard = monadicIO $ forAllM someBigString $ \ str -> do
  run $ E.run_ $ E.enumList 2 [str] E.$$ E.joinI (compress Nothing E.$$ dropAll)

prop_compressAndCheckLength :: Property
prop_compressAndCheckLength = monadicIO $ forAllM someBigString $ \ str -> do
  len <- run $ E.run_ $ E.enumList 2 [str] E.$$ E.joinI (compress Nothing E.$$ EL.fold (\ acc el -> acc + B.length el) 0)
  assert (len - 32 > B.length str `div` 2) -- random strings don't compress very well

prop_chain :: Property
prop_chain = monadicIO $ forAllM someBigString $ \ str -> do
  str' <- run $ E.run_ $ E.enumList 2 [str] E.$$ E.joinI (compress Nothing E.$$ E.joinI (decompress Nothing E.$$ EL.consume))
  return $ str == B.concat str'

prop_compressThenDecompress :: Property
prop_compressThenDecompress = monadicIO $ forAllM someBigString $ \ str -> do
  blob <- run $ E.run_ $ E.enumList 2 [str] E.$$ E.joinI (compress Nothing E.$$ EL.consume)
  let blob' = B.concat blob
  randIdx <- pick $ elements [0..B.length blob'-1]
  let resplit = let (x,y) = B.splitAt randIdx blob' in [x,y]
  str' <- run $ E.run_ $ E.enumList 2 resplit E.$$ E.joinI (decompress Nothing E.$$ EL.consume)
  return $ str == B.concat str'

prop_decompressRandom :: Property
prop_decompressRandom = monadicIO $ forAllM someBigString $ \ str -> do
  header <- run $ E.run_ $ E.enumList 2 [] E.$$ E.joinI (compress Nothing E.$$ EL.consume)
  let blob = header ++ [str]
  run $ E.run_ $ E.enumList 2 blob E.$$ E.joinI (decompress Nothing E.$$ dropAll)

prop_decompressCorrupt :: Property
prop_decompressCorrupt = expectFailure $ monadicIO $ forAllM someBigString $ \ str -> do
  header <- run $ E.run_ $ E.enumList 2 [] E.$$ E.joinI (compress Nothing E.$$ EL.consume)
  let header' = B.concat header
  randVal <- pick $ elements [0..255::Word8]
  randIdx <- pick $ elements [0..B.length header'-1]
  let (left, right) = B.splitAt randIdx header'
      updated = left `B.append` (randVal `B.cons` B.tail right)
      blob = [updated, str]
  run $ E.run_ $ E.enumList 2 blob E.$$ E.joinI (decompress Nothing E.$$ dropAll)