streamly-bytestring-0.1.3: test/Main.hs

{-# LANGUAGE FlexibleContexts #-}

module Main where

import Data.ByteString (ByteString)
import Data.Word (Word8)
import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
import GHC.IO.Handle (Handle)
import GHC.Ptr (minusPtr)
import System.Random (randomIO)
import Streamly.FileSystem.Handle (readChunks)
import System.IO (openFile, IOMode(ReadMode))
import System.IO.Temp (withSystemTempFile)
import Test.Hspec
import Test.Hspec.QuickCheck
import Test.QuickCheck.Instances.ByteString ()

-- Internal imports
import Streamly.Internal.Data.Array.Foreign.Type (Array(..))

import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Streamly.External.ByteString as Strict
import qualified Streamly.External.ByteString.Lazy as Lazy
import qualified Streamly.Prelude as S

streamToByteString :: S.MonadAsync m => S.SerialT m (Array Word8) -> m ByteString
streamToByteString stream = S.foldl' (<>) mempty $ S.map Strict.fromArray stream

checkFileContent :: FilePath -> Handle -> IO ()
checkFileContent filename handle' = do
    print $ "Checking " <> filename
    bsContent <- BS.hGetContents handle'
    handle <- openFile filename ReadMode
    bsStreamly <- streamToByteString $ S.unfold readChunks handle
    bsContent `shouldBe` bsStreamly

word8List :: Int -> IO [Word8]
word8List l =
    S.toList $
    S.take l $
    S.map fromIntegral $
    S.map (\x -> abs x `mod` 256) $ S.repeatM (randomIO :: IO Int)

propFoldTestStrict :: [Word8] -> Spec
propFoldTestStrict bl =
    prop
        ("Strict: fold write . fromList = pack" ++
         " -- Size: " ++ show (length bl) ++ " bytes") $ do
        bl' <- fmap BS.unpack $ S.fold Strict.write $ S.fromList bl
        bl' `shouldBe` bl

propNFoldTestStrict :: Int -> [Word8] -> Spec
propNFoldTestStrict n bl =
    prop
        ("Strict: fold (writeN n) . fromList = pack . take n" ++
         " -- Size: " ++ show n ++ " bytes") $ do
        bl' <- fmap BS.unpack $ S.fold (Strict.writeN n) $ S.fromList bl
        bl' `shouldBe` take n bl

propUnfoldTestStrict :: [Word8] -> Spec
propUnfoldTestStrict bl =
    prop
        ("Strict: toList . unfold read . pack = id" ++
         " -- Size: " ++ show (length bl) ++ " bytes") $ do
        bl' <- S.toList (S.unfold Strict.read (BS.pack bl))
        bl' `shouldBe` bl

propUnfoldTestLazy :: [Word8] -> Spec
propUnfoldTestLazy bl =
    prop
        ("Lazy: toList . unfold read . pack = id" ++
         " -- Size: " ++ show (length bl) ++ " bytes") $ do
        bl' <- S.toList (S.unfold Lazy.read (BSL.pack bl))
        bl' `shouldBe` bl

propFromChunks :: Spec
propFromChunks =
    prop "Lazy.fromChunks = BSL.fromChunks" $ \aL -> do
        x1 <- Lazy.fromChunks $ S.map Strict.toArray $ S.fromList aL
        let x2 = BSL.fromChunks aL
        x1 `shouldBe` x2

propFromChunksIO :: Spec
propFromChunksIO =
    prop "Lazy.fromChunks = BSL.fromChunks" $ \aL -> do
        x1 <- Lazy.fromChunksIO $ S.map Strict.toArray $ S.fromList aL
        let x2 = BSL.fromChunks aL
        x1 `shouldBe` x2

testFromChunksIOLaziness :: Word8 -> IO Word8
testFromChunksIOLaziness h = do
    lbs <-
        Lazy.fromChunksIO $
        S.fromList (Strict.toArray (BS.singleton h) : undefined)
    return $ BSL.head lbs


main :: IO ()
main =
    hspec $ do
        describe "Array tests" $ do
            it "Strict fromArray" $
                mapM_
                    (flip withSystemTempFile checkFileContent . show)
                    ([1 .. 100] :: [Int])
            prop "Strict Identity" $ \bs ->
                bs `shouldBe` Strict.fromArray (Strict.toArray bs)
            prop "Strict Identity (with offset)" $ \bs ->
                let bs' = BS.drop 5 bs
                in bs' `shouldBe` Strict.fromArray (Strict.toArray bs')
            prop "toArray never produces negative length" $ \bs ->
                -- 'BS.drop 5' to trigger non-zero offset
                let (Array nfp endPtr) = Strict.toArray (BS.drop 5 bs)
                in (endPtr `minusPtr` unsafeForeignPtrToPtr nfp) >= 0 `shouldBe` True
            prop "Lazy Identity" $ \bs -> do
                bs2 <- Lazy.fromChunks . Lazy.toChunks $ bs
                bs `shouldBe` bs2
        wl0 <- runIO $ word8List 0
        wlM <- runIO $ word8List 900
        wlL <- runIO $ word8List 73700
        describe "Strict: Fold tests" $ do
            propFoldTestStrict wl0
            propFoldTestStrict wlM
            propFoldTestStrict wlL
        describe "Strict: N Fold tests" $ do
            propNFoldTestStrict 0 wl0
            propNFoldTestStrict 900 wlM
            propNFoldTestStrict 73700 wlL
        describe "Strict: Unfold tests" $ do
            propUnfoldTestStrict wl0
            propUnfoldTestStrict wlM
            propUnfoldTestStrict wlL
        describe "Lazy: Unfold tests" $ do
            propUnfoldTestLazy wl0
            propUnfoldTestLazy wlM
            propUnfoldTestLazy wlL
        describe "Laziness of fromChunksIO" $ do
            it "Should not fail" $ do
                w <- testFromChunksIOLaziness 100
                w `shouldBe` 100
        describe "Correctness of fromChunks" propFromChunks
        describe "Correctness of fromChunksIO" propFromChunksIO