on 666eb07 help sign in
235 lines 7.9 kB history raw
1-- |
2-- Module : Streamly.Test.FileSystem.Handle
3-- Copyright : (c) 2020 Composewell technologies
4-- License : BSD-3-Clause
5-- Maintainer : streamly@composewell.com
6-- Stability : experimental
7-- Portability : GHC
9module Streamly.Test.FileSystem.Handle (main) where
11import Data.Functor.Identity (runIdentity)
12import Data.Word (Word8)
13import Streamly.Internal.Data.Unboxed (sizeOf)
14import Streamly.Internal.Data.Stream (Stream)
15import System.FilePath ((</>))
16import System.IO
17 ( Handle
18 , IOMode(..)
19 , SeekMode(..)
20 , hClose
21 , hFlush
22 , hSeek
23 , openFile
24 )
25import System.IO.Temp (withSystemTempDirectory)
26import Test.QuickCheck (Property, forAll, Gen, vectorOf, choose)
27import Test.QuickCheck.Monadic (monadicIO, assert, run)
29import qualified Streamly.Data.Fold as Fold
30import qualified Streamly.Internal.FileSystem.Handle as Handle
31import qualified Streamly.Internal.Data.Stream as Stream
32import qualified Streamly.Internal.Data.Array as Array
33import qualified Streamly.Internal.Unicode.Stream as Unicode
35import Test.Hspec as H
36import Test.Hspec.QuickCheck
38allocOverhead :: Int
39allocOverhead = 2 * sizeOf (undefined :: Int)
41defaultChunkSize :: Int
42defaultChunkSize = 32 * k - allocOverhead
43 where k = 1024
45maxArrLen :: Int
46maxArrLen = defaultChunkSize * 8
48maxTestCount :: Int
49maxTestCount = 10
51chooseWord8 :: (Word8, Word8) -> Gen Word8
52chooseWord8 = choose
54toList :: Monad m => Stream m a -> m [a]
55toList = Stream.fold Fold.toList
57utf8ToString :: Array.Array Word8 -> String
58utf8ToString =
59 runIdentity . toList . Unicode.decodeUtf8' . Array.read
61testData :: String
62testData = "This is the test data for FileSystem.Handle ??`!@#$%^&*~~))`]"
64testDataLarge :: String
65testDataLarge = concat $ replicate 6000 testData
67testBinData :: String
68testBinData = "01234567890123456789012345678901234567890123456789"
70executor :: (Handle -> Stream IO Char) -> IO (Stream IO Char)
71executor f =
72 withSystemTempDirectory "fs_handle" $ \fp -> do
73 let fpath = fp </> "tmp_read.txt"
74 writeFile fpath testDataLarge
75 h <- openFile fpath ReadMode
76 return $ f h
78readFromHandle :: IO (Stream IO Char)
79readFromHandle =
80 let f = Unicode.decodeUtf8 . Stream.unfold Handle.reader
81 in executor f
83readWithBufferFromHandle :: IO (Stream IO Char)
84readWithBufferFromHandle =
85 let f1 = (\h -> (1024, h))
86 f2 = Unicode.decodeUtf8 . Stream.unfold Handle.readerWith . f1
87 in executor f2
89readChunksFromHandle :: IO (Stream IO Char)
90readChunksFromHandle =
91 let f = Unicode.decodeUtf8
92 . Stream.concatMap Array.read
93 . Stream.unfold Handle.chunkReader
94 in executor f
96readChunksWithBuffer :: IO (Stream IO Char)
97readChunksWithBuffer =
98 let f1 = (\h -> (1024, h))
99 f2 =
100 Unicode.decodeUtf8
101 . Stream.concatMap Array.read
102 . Stream.unfold Handle.chunkReaderWith
103 . f1
104 in executor f2
106testRead :: IO (Stream IO Char) -> Property
107testRead fn = monadicIO $ do
108 let v2 = Stream.fromList testDataLarge
109 v1 <- run fn
110 res <- run $ Stream.eqBy (==) v1 v2
111 assert res
113testWrite :: (Handle -> Fold.Fold IO Word8 ()) -> Property
114testWrite hfold =
115 forAll (choose (0, maxArrLen)) $ \len ->
116 forAll (vectorOf len $ chooseWord8 (0, 255)) $ \list0 ->
117 monadicIO $ do
118 res <- run $ go list0
119 assert res
121 where
123 go list =
124 withSystemTempDirectory "fs_handle" $ \fp -> do
125 let fpathWrite = fp </> "tmp_write.txt"
126 writeFile fpathWrite ""
127 h <- openFile fpathWrite ReadWriteMode
128 hSeek h AbsoluteSeek 0
129 _ <- Stream.fold (hfold h) $ Stream.fromList list
130 hFlush h
131 hSeek h AbsoluteSeek 0
132 ls <- toList $ Stream.unfold Handle.reader h
133 hClose h
134 return (ls == list)
136testWriteWithChunk :: Property
137testWriteWithChunk =
138 monadicIO $ do
139 res <- run go
140 assert res
142 where
144 go =
145 withSystemTempDirectory "fs_handle" $ \fp -> do
146 let fpathRead = fp </> "tmp_read.txt"
147 fpathWrite = fp </> "tmp_write.txt"
148 writeFile fpathRead testDataLarge
149 writeFile fpathWrite ""
150 hr <- openFile fpathRead ReadMode
151 hw <- openFile fpathWrite ReadWriteMode
152 hSeek hw AbsoluteSeek 0
153 _ <- Stream.fold (Handle.writeChunks hw)
154 $ Stream.unfold Handle.chunkReaderWith (1024, hr)
155 hFlush hw
156 hSeek hw AbsoluteSeek 0
157 ls <- toList $ Stream.unfold Handle.reader hw
158 let arr = Array.fromList ls
159 return (testDataLarge == utf8ToString arr)
161testReadChunksFromToWith :: Int -> Int -> Int -> [[Word8]] -> Property
162testReadChunksFromToWith from to buffSize res = monadicIO $ run go
164 where
166 go =
167 withSystemTempDirectory "fs_handle" $ \fp -> do
168 let fpathRead = fp </> "tmp_read.txt"
169 writeFile fpathRead testBinData
170 h <- openFile fpathRead ReadMode
171 ls <-
172 toList
173 $ Stream.unfold
174 Handle.chunkReaderFromToWith (from, to, buffSize, h)
175 return (res `shouldBe` fmap Array.toList ls)
177-- Test for first byte
178testReadChunksFromToWithFirstByte :: Property
179testReadChunksFromToWithFirstByte = testReadChunksFromToWith 0 0 15 [[48]]
181-- Test for second byte
182testReadChunksFromToWithSecondByte :: Property
183testReadChunksFromToWithSecondByte = testReadChunksFromToWith 1 1 15 [[49]]
185-- Test for second to 10th bytes
186testReadChunksFromToWithSecondToTenthBytes :: Property
187testReadChunksFromToWithSecondToTenthBytes =
188 testReadChunksFromToWith 1 10 15 [[49,50,51,52,53,54,55,56,57,48]]
190-- Test for offset of buffer size
191testReadChunksFromToWithBuffSizeOffset :: Property
192testReadChunksFromToWithBuffSizeOffset =
193 testReadChunksFromToWith 15 25 15 [[53,54,55,56,57,48,49,50,51,52,53]]
195-- Test with multi buffer size
196testReadChunksFromToWithMultiBuff :: Property
197testReadChunksFromToWithMultiBuff =
198 testReadChunksFromToWith
199 5 22 5 [[53,54,55,56,57],[48,49,50,51,52],[53,54,55,56,57],[48,49,50]]
201testReadChunksFromToWithRangeInvalid :: Property
202testReadChunksFromToWithRangeInvalid = testReadChunksFromToWith 15 5 15 []
204moduleName :: String
205moduleName = "FileSystem.Handle"
207main :: IO ()
208main =
209 hspec $
210 H.parallel $
211 modifyMaxSuccess (const maxTestCount) $ do
212 describe moduleName $ do
213 describe "Read From Handle" $ do
214 prop "read" $ testRead readFromHandle
215 prop "readWith" $ testRead readWithBufferFromHandle
216 prop "readChunks" $ testRead readChunksFromHandle
217 prop "readChunksWith" $ testRead readChunksWithBuffer
218 prop "readChunksFromToWith (0,0,n)"
219 testReadChunksFromToWithFirstByte
220 prop "readChunksFromToWith (1,1,n)"
221 testReadChunksFromToWithSecondByte
222 prop "readChunksFromToWith (1,10,n)"
223 testReadChunksFromToWithSecondToTenthBytes
224 prop "readChunksFromToWith (n,<2n,n)"
225 testReadChunksFromToWithBuffSizeOffset
226 prop "readChunksFromToWith (n,>2n,n)"
227 testReadChunksFromToWithMultiBuff
228 prop "readChunksFromToWith (n,<n,n)"
229 testReadChunksFromToWithRangeInvalid
230 describe "Write To Handle" $ do
231 prop "write" $ testWrite Handle.write
232 prop "writeWith"
233 $ testWrite $ Handle.writeWith 1024
234 -- XXX This test needs a lot of stack when built with -O0
235 prop "writeChunks" testWriteWithChunk