git.iko.soy/streamly
on 8fa60a9 help sign in
streamly/benchmark/FileIO.hs
312 lines 13 kB history raw
1-- |
2-- Module : Main
3-- Copyright : (c) 2019 Harendra Kumar
4--
5-- License : BSD3
6-- Maintainer : harendra.kumar@gmail.com
8{-# LANGUAGE CPP #-}
10import Control.DeepSeq (NFData)
11import Data.Functor.Identity (runIdentity)
12import System.IO (openFile, IOMode(..), Handle, hClose)
13import System.Process.Typed (shell, runProcess_)
15import Data.IORef
16import Gauge
18import qualified Streamly.FileSystem.Handle as FH
19import qualified Streamly.Mem.Array as A
20import qualified Streamly.Prelude as S
21import qualified Streamly.Fold as FL
22import qualified Streamly.String as SS
24#ifdef DEVBUILD
25import Data.Char (ord, chr)
26#endif
28-- Input and output file handles
29data Handles = Handles Handle Handle
31scratchDir :: String
32scratchDir = "benchmark/scratch/"
34outfile :: String
35outfile = scratchDir ++ "out.txt"
37blockSize, blockCount :: Int
38blockSize = 32768
39blockCount = 3200
41#ifdef DEVBUILD
42-- This is a 500MB text file for text processing benchmarks. We cannot
43-- have it in the repo, therefore we use it locally with DEVBUILD
44-- conditional (enabled by "dev" cabal flag). Some tests that depend on
45-- this file are available only in DEVBUILD mode.
46infile :: String
47infile = "benchmark/text-processing/gutenberg-500.txt"
49fileSize :: Int
50fileSize = blockSize * blockCount
52foreign import ccall unsafe "u_iswspace"
53 iswspace :: Int -> Int
55-- Code copied from base/Data.Char to INLINE it
56{-# INLINE isSpace #-}
57isSpace :: Char -> Bool
58-- isSpace includes non-breaking space
59-- The magic 0x377 isn't really that magical. As of 2014, all the codepoints
60-- at or below 0x377 have been assigned, so we shouldn't have to worry about
61-- any new spaces appearing below there. It would probably be best to
62-- use branchless ||, but currently the eqLit transformation will undo that,
63-- so we'll do it like this until there's a way around that.
64isSpace c
65 | uc <= 0x377 = uc == 32 || uc - 0x9 <= 4 || uc == 0xa0
66 | otherwise = iswspace (ord c) /= 0
67 where
68 uc = fromIntegral (ord c) :: Word
69#else
70infile :: String
71infile = scratchDir ++ "in-100MB.txt"
72#endif
74main :: IO ()
75main = do
76#ifndef DEVBUILD
77 -- XXX will this work on windows/msys?
78 let cmd = "mkdir -p " ++ scratchDir
79 ++ "; test -e " ++ infile
80 ++ " || { echo \"creating input file " ++ infile
81 ++ "\" && dd if=/dev/random of=" ++ infile
82 ++ " bs=" ++ show blockSize
83 ++ " count=" ++ show blockCount
84 ++ ";}"
86 runProcess_ (shell cmd)
87#endif
88 inHandle <- openFile infile ReadMode
89 outHandle <- openFile outfile WriteMode
90 href <- newIORef $ Handles inHandle outHandle
91 devNull <- openFile "/dev/null" WriteMode
93 defaultMain
94 [ bgroup "readArray"
95 [ mkBench "last" href $ do
96 Handles inh _ <- readIORef href
97 let s = FH.readArrays inh
98 larr <- S.last s
99 case larr of
100 Nothing -> return Nothing
101 Just arr -> A.readIndex arr (A.length arr - 1)
102 -- Note: this cannot be fairly compared with GNU wc -c or wc -m as
103 -- wc uses lseek to just determine the file size rather than reading
104 -- and counting characters.
105 , mkBench "length (bytecount)" href $ do
106 Handles inh _ <- readIORef href
107 let s = FH.readArrays inh
108 S.sum (S.map A.length s)
109 , mkBench "linecount" href $ do
110 Handles inh _ <- readIORef href
111 S.length $ A.splitArraysOn 10 $ FH.readArrays inh
112 , mkBench "sum" href $ do
113 let foldlArr' f z = runIdentity . S.foldl' f z . A.read
114 Handles inh _ <- readIORef href
115 let s = FH.readArrays inh
116 S.foldl' (\acc arr -> acc + foldlArr' (+) 0 arr) 0 s
117 , mkBench "cat" href $ do
118 Handles inh _ <- readIORef href
119 FH.writeArrays devNull $ FH.readArraysOfUpto (256*1024) inh
120 ]
121 , bgroup "readStream"
122 [ mkBench "last" href $ do
123 Handles inh _ <- readIORef href
124 S.last $ FH.read inh
125 , mkBench "length (bytecount)" href $ do
126 Handles inh _ <- readIORef href
127 S.length $ FH.read inh
128 , mkBench "linecount" href $ do
129 Handles inh _ <- readIORef href
130 S.length
131 $ flip SS.foldLines FL.drain
132 $ SS.decodeChar8
133 $ FH.read inh
134 , mkBench "sum" href $ do
135 Handles inh _ <- readIORef href
136 S.sum $ FH.read inh
137 , mkBench "cat" href $ do
138 Handles inh _ <- readIORef href
139 FH.write devNull $ FH.read inh
140 ]
141 , bgroup "copyArray"
142 [ mkBench "copy" href $ do
143 Handles inh outh <- readIORef href
144 let s = FH.readArrays inh
145 FH.writeArrays outh s
146 ]
147#ifdef DEVBUILD
148 -- This takes a little longer therefore put under the dev conditional
149 , bgroup "copyStream"
150 [ mkBench "fromToHandle" href $ do
151 Handles inh outh <- readIORef href
152 FH.write outh (FH.read inh)
153 ]
154 -- This needs an ascii file, as decode just errors out.
155 , bgroup "decode-encode"
156 [ mkBench "char8" href $ do
157 Handles inh outh <- readIORef href
158 FH.write outh
159 $ SS.encodeChar8
160 $ SS.decodeChar8
161 $ FH.read inh
162 , mkBench "utf8" href $ do
163 Handles inh outh <- readIORef href
164 FH.write outh
165 $ SS.encodeUtf8
166 $ SS.decodeUtf8
167 $ FH.read inh
168 ]
169 , bgroup "grouping"
170 [ mkBench "chunksOf 1 (toArray)" href $ do
171 Handles inh _ <- readIORef href
172 S.length $ FL.chunksOf fileSize (A.toArrayN fileSize)
173 (FH.read inh)
175 , mkBench "chunksOf 1" href $ do
176 Handles inh _ <- readIORef href
177 S.length $ FL.chunksOf 1 FL.drain (FH.read inh)
178 , mkBench "chunksOf 10" href $ do
179 Handles inh _ <- readIORef href
180 S.length $ FL.chunksOf 10 FL.drain (FH.read inh)
181 , mkBench "chunksOf 1000" href $ do
182 Handles inh _ <- readIORef href
183 S.length $ FL.chunksOf 1000 FL.drain (FH.read inh)
184 ]
185 , bgroup "group-ungroup"
186 [ mkBench "lines-unlines" href $ do
187 Handles inh outh <- readIORef href
188 FH.write outh
189 $ SS.encodeChar8
190 $ SS.unlines
191 $ SS.lines
192 $ SS.decodeChar8
193 $ FH.read inh
194 , mkBench "lines-unlines-arrays" href $ do
195 Handles inh outh <- readIORef href
196 FH.writeArraysPackedUpto (1024*1024) outh
197 $ S.insertAfterEach (return $ A.fromList [10])
198 $ A.splitArraysOn 10
199 $ FH.readArraysOfUpto (1024*1024) inh
200 , mkBench "words-unwords" href $ do
201 Handles inh outh <- readIORef href
202 FH.write outh
203 $ SS.encodeChar8
204 $ SS.unwords
205 $ SS.words
206 $ SS.decodeChar8
207 $ FH.read inh
208 ]
210 , let lf = fromIntegral (ord '\n')
211 lfarr = A.fromList [lf]
212 isSp = isSpace . chr . fromIntegral
213 toarr = A.fromList . map (fromIntegral . ord)
214 in bgroup "splitting"
215 [ bgroup "predicate"
216 [ mkBench "splitBy \\n (line count)" href $ do
217 Handles inh _ <- readIORef href
218 (S.length $ FL.splitBy (== lf) FL.drain
219 $ FH.read inh) -- >>= print
220 , mkBench "splitSuffixBy \\n (line count)" href $ do
221 Handles inh _ <- readIORef href
222 (S.length $ FL.splitSuffixBy (== lf) FL.drain
223 $ FH.read inh) -- >>= print
224 , mkBench "wordsBy isSpace (word count)" href $ do
225 Handles inh _ <- readIORef href
226 (S.length $ FL.wordsBy isSp FL.drain
227 $ FH.read inh) -- >>= print
228 ]
230 , bgroup "empty-pattern"
231 [ mkBench "splitOn \"\"" href $ do
232 Handles inh _ <- readIORef href
233 (S.length $ FL.splitOn (A.fromList []) FL.drain
234 $ FH.read inh) -- >>= print
235 , mkBench "splitSuffixOn \"\"" href $ do
236 Handles inh _ <- readIORef href
237 (S.length $ FL.splitSuffixOn (A.fromList []) FL.drain
238 $ FH.read inh) -- >>= print
239 ]
240 , bgroup "short-pattern"
241 [ mkBench "splitOn \\n (line count)" href $ do
242 Handles inh _ <- readIORef href
243 (S.length $ FL.splitOn lfarr FL.drain
244 $ FH.read inh) -- >>= print
245 , mkBench "splitSuffixOn \\n (line count)" href $ do
246 Handles inh _ <- readIORef href
247 (S.length $ FL.splitSuffixOn lfarr FL.drain
248 $ FH.read inh) -- >>= print
249 , mkBench "splitOn a" href $ do
250 Handles inh _ <- readIORef href
251 (S.length $ FL.splitOn (toarr "a") FL.drain
252 $ FH.read inh) -- >>= print
253 , mkBench "splitOn \\r\\n" href $ do
254 Handles inh _ <- readIORef href
255 (S.length $ FL.splitOn (toarr "\r\n") FL.drain
256 $ FH.read inh) -- >>= print
257 , mkBench "splitSuffixOn \\r\\n)" href $ do
258 Handles inh _ <- readIORef href
259 (S.length $ FL.splitSuffixOn (toarr "\r\n") FL.drain
260 $ FH.read inh) -- >>= print
261 , mkBench "splitOn aa" href $ do
262 Handles inh _ <- readIORef href
263 (S.length $ FL.splitOn (toarr "aa") FL.drain
264 $ FH.read inh) -- >>= print
265 , mkBench "splitOn aaaa" href $ do
266 Handles inh _ <- readIORef href
267 (S.length $ FL.splitOn (toarr "aaaa") FL.drain
268 $ FH.read inh) -- >>= print
269 , mkBench "splitOn abcdefgh" href $ do
270 Handles inh _ <- readIORef href
271 (S.length $ FL.splitOn (toarr "abcdefgh") FL.drain
272 $ FH.read inh) -- >>= print
273 ]
274 , bgroup "long-pattern"
275 [ mkBench "splitOn abcdefghi" href $ do
276 Handles inh _ <- readIORef href
277 (S.length $ FL.splitOn (toarr "abcdefghi") FL.drain
278 $ FH.read inh) -- >>= print
279 , mkBench "splitOn catcatcatcatcat" href $ do
280 Handles inh _ <- readIORef href
281 (S.length $ FL.splitOn (toarr "catcatcatcatcat") FL.drain
282 $ FH.read inh) -- >>= print
283 , mkBench "splitOn abc...xyz" href $ do
284 Handles inh _ <- readIORef href
285 (S.length $ FL.splitOn
286 (toarr "abcdefghijklmnopqrstuvwxyz")
287 FL.drain
288 $ FH.read inh) -- >>= print
289 , mkBench "splitSuffixOn abc...xyz" href $ do
290 Handles inh _ <- readIORef href
291 (S.length $ FL.splitSuffixOn
292 (toarr "abcdefghijklmnopqrstuvwxyz")
293 FL.drain
294 $ FH.read inh) -- >>= print
295 ]
296 ]
297#endif
298 ]
300 where
302 mkBench :: NFData b => String -> IORef Handles -> IO b -> Benchmark
303 mkBench name ref action =
304 bench name $ perRunEnv (do
305 (Handles inh outh) <- readIORef ref
306 hClose inh
307 hClose outh
308 inHandle <- openFile infile ReadMode
309 outHandle <- openFile outfile WriteMode
310 writeIORef ref (Handles inHandle outHandle)
311 )
312 (\_ -> action)