git.iko.soy/streamly
on 5bcd2d8 help sign in
streamly/test/Streamly/Test/FileSystem/Handle.hs
173 lines 5.7 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 Foreign.Storable (Storable(..))
14import Streamly.Internal.Data.Stream.IsStream (IsStream, SerialT)
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.FileSystem.Handle as Handle
31import qualified Streamly.Internal.Data.Stream.IsStream as Stream
32import qualified Streamly.Internal.Data.Array.Foreign 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
54utf8ToString :: Array.Array Word8 -> String
55utf8ToString =
56 runIdentity . Stream.toList . Unicode.decodeUtf8' . Array.toStream
58testData :: String
59testData = "This is the test data for FileSystem.Handle ??`!@#$%^&*~~))`]"
61testDataLarge :: String
62testDataLarge = concat $ replicate 6000 testData
64executor :: (Handle -> SerialT IO Char) -> IO (SerialT IO Char)
65executor f =
66 withSystemTempDirectory "fs_handle" $ \fp -> do
67 let fpath = fp </> "tmp_read.txt"
68 writeFile fpath testDataLarge
69 h <- openFile fpath ReadMode
70 return $ f h
72readFromHandle :: IO (SerialT IO Char)
73readFromHandle =
74 let f = Unicode.decodeUtf8 . Stream.unfold Handle.read
75 in executor f
77readWithBufferFromHandle :: IO (SerialT IO Char)
78readWithBufferFromHandle =
79 let f1 = (\h -> (1024, h))
80 f2 = Unicode.decodeUtf8 . Stream.unfold Handle.readWithBufferOf . f1
81 in executor f2
83readChunksFromHandle :: IO (SerialT IO Char)
84readChunksFromHandle =
85 let f = Unicode.decodeUtf8
86 . Stream.concatMap Array.toStream
87 . Stream.unfold Handle.readChunks
88 in executor f
90readChunksWithBuffer :: IO (SerialT IO Char)
91readChunksWithBuffer =
92 let f1 = (\h -> (1024, h))
93 f2 =
94 Unicode.decodeUtf8
95 . Stream.concatMap Array.toStream
96 . Stream.unfold Handle.readChunksWithBufferOf
97 . f1
98 in executor f2
100testRead :: (IsStream t) => IO (t IO Char) -> Property
101testRead fn = monadicIO $ do
102 let v2 = Stream.fromList testDataLarge
103 v1 <- run fn
104 res <- run $ Stream.eqBy (==) v1 v2
105 assert res
107testWrite :: (Handle -> Fold.Fold IO Word8 ()) -> Property
108testWrite hfold =
109 forAll (choose (0, maxArrLen)) $ \len ->
110 forAll (vectorOf len $ chooseWord8 (0, 255)) $ \list0 ->
111 monadicIO $ do
112 res <- run $ go list0
113 assert res
115 where
117 go list =
118 withSystemTempDirectory "fs_handle" $ \fp -> do
119 let fpathWrite = fp </> "tmp_write.txt"
120 writeFile fpathWrite ""
121 h <- openFile fpathWrite ReadWriteMode
122 hSeek h AbsoluteSeek 0
123 _ <- Stream.fold (hfold h) $ Stream.fromList list
124 hFlush h
125 hSeek h AbsoluteSeek 0
126 ls <- Stream.toList $ Stream.unfold Handle.read h
127 hClose h
128 return (ls == list)
130testWriteWithChunk :: Property
131testWriteWithChunk =
132 monadicIO $ do
133 res <- run go
134 assert res
136 where
138 go =
139 withSystemTempDirectory "fs_handle" $ \fp -> do
140 let fpathRead = fp </> "tmp_read.txt"
141 fpathWrite = fp </> "tmp_write.txt"
142 writeFile fpathRead testDataLarge
143 writeFile fpathWrite ""
144 hr <- openFile fpathRead ReadMode
145 hw <- openFile fpathWrite ReadWriteMode
146 hSeek hw AbsoluteSeek 0
147 _ <- Stream.fold (Handle.writeChunks hw)
148 $ Stream.unfold Handle.readChunksWithBufferOf (1024, hr)
149 hFlush hw
150 hSeek hw AbsoluteSeek 0
151 ls <- Stream.toList $ Stream.unfold Handle.read hw
152 let arr = Array.fromList ls
153 return (testDataLarge == utf8ToString arr)
155moduleName :: String
156moduleName = "FileSystem.Handle"
158main :: IO ()
159main =
160 hspec $
161 H.parallel $
162 modifyMaxSuccess (const maxTestCount) $ do
163 describe moduleName $ do
164 describe "Read From Handle" $ do
165 prop "read" $ testRead readFromHandle
166 prop "readWithBufferOf" $ testRead readWithBufferFromHandle
167 prop "readChunks" $ testRead readChunksFromHandle
168 prop "readChunksWithBufferOf" $ testRead readChunksWithBuffer
169 describe "Write To Handle" $ do
170 prop "write" $ testWrite Handle.write
171 prop "writeWithBufferOf" $ testWrite $ Handle.writeWithBufferOf 1024
172 -- XXX This test needs a lot of stack when built with -O0
173 prop "writeChunks" testWriteWithChunk