2-- Module : Streamly.Benchmark.FileSystem.Handle
3-- Copyright : (c) 2019 Composewell Technologies
6-- Maintainer : streamly@composewell.com
7-- Stability : experimental
11{-# LANGUAGE ScopedTypeVariables #-}
13#ifdef __HADDOCK_VERSION__
18{-# LANGUAGE TemplateHaskell #-}
19{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
22module Handle.ReadWrite
26import Control.Exception (SomeException)
27import System.IO (Handle, hClose)
28import Prelude hiding (last, length)
30import qualified Streamly.Data.Fold as FL
31import qualified Streamly.Unicode.Stream as SS
32import qualified Streamly.FileSystem.Handle as FH
33import qualified Streamly.Internal.Data.Unfold as IUF
34import qualified Streamly.Internal.Unicode.Stream as IUS
35import qualified Streamly.Internal.FileSystem.Handle as IFH
36import qualified Streamly.Internal.Memory.ArrayStream as AS
37import qualified Streamly.Internal.Memory.Unicode.Array as IUA
38import qualified Streamly.Internal.Data.Stream.IsStream as IP
39import qualified Streamly.Memory.Array as A
40import qualified Streamly.Prelude as S
42import Gauge hiding (env)
46import Foreign.Storable (Storable)
47import Streamly.Internal.Data.Stream.StreamD.Type (Step(..))
49import qualified Streamly.Internal.Data.Stream.StreamD.Type as D
50import qualified Streamly.Internal.Data.Tuple.Strict as Strict
51import qualified Streamly.Internal.Memory.Array as A
52import qualified Streamly.Internal.Memory.Array.Types as AT
57-------------------------------------------------------------------------------
59-------------------------------------------------------------------------------
62copyChunks :: Handle -> Handle -> IO ()
63copyChunks inh outh = S.fold (IFH.writeChunks outh) $ IFH.toChunks inh
66inspect $ hasNoTypeClasses 'copyChunks
67inspect $ 'copyChunks `hasNoType` ''Step
71copyCodecUtf8ArraysLenient :: Handle -> Handle -> IO ()
72copyCodecUtf8ArraysLenient inh outh =
73 S.fold (FH.write outh)
75 $ IUS.decodeUtf8ArraysLenient
79inspect $ hasNoTypeClasses 'copyCodecUtf8ArraysLenient
80-- inspect $ 'copyCodecUtf8ArraysLenient `hasNoType` ''Step
83o_1_space_copy_chunked :: BenchEnv -> [Benchmark]
84o_1_space_copy_chunked env =
85 [ bgroup "copy/toChunks"
86 [ mkBench "toNull" env $ \inH _ ->
87 copyChunks inH (nullH env)
88 , mkBench "raw" env $ \inH outH ->
90 , mkBenchSmall "decodeEncodeUtf8Lenient" env $ \inH outH ->
91 copyCodecUtf8ArraysLenient inH outH
95-- TBD reading with unfold
97-------------------------------------------------------------------------------
98-- Exceptions readChunks
99-------------------------------------------------------------------------------
101-- | Send the file contents to /dev/null with exception handling
102readChunksOnException :: Handle -> Handle -> IO ()
103readChunksOnException inh devNull =
104 let readEx = IUF.onException (\_ -> hClose inh) FH.readChunks
105 in IUF.fold readEx (IFH.writeChunks devNull) inh
108inspect $ hasNoTypeClasses 'readChunksOnException
109-- inspect $ 'readChunksOnException `hasNoType` ''Step
112-- | Send the file contents to /dev/null with exception handling
113readChunksBracket_ :: Handle -> Handle -> IO ()
114readChunksBracket_ inh devNull =
115 let readEx = IUF.bracket_ return (\_ -> hClose inh) FH.readChunks
116 in IUF.fold readEx (IFH.writeChunks devNull) inh
119inspect $ hasNoTypeClasses 'readChunksBracket_
120-- inspect $ 'readChunksBracket `hasNoType` ''Step
123readChunksBracket :: Handle -> Handle -> IO ()
124readChunksBracket inh devNull =
125 let readEx = IUF.bracket return (\_ -> hClose inh) FH.readChunks
126 in IUF.fold readEx (IFH.writeChunks devNull) inh
128o_1_space_copy_exceptions_readChunks :: BenchEnv -> [Benchmark]
129o_1_space_copy_exceptions_readChunks env =
130 [ bgroup "copy/readChunks/exceptions"
131 [ mkBench "UF.onException" env $ \inH _ ->
132 readChunksOnException inH (nullH env)
133 , mkBench "UF.bracket_" env $ \inH _ ->
134 readChunksBracket_ inH (nullH env)
135 , mkBench "UF.bracket" env $ \inH _ ->
136 readChunksBracket inH (nullH env)
140-------------------------------------------------------------------------------
141-- Exceptions toChunks
142-------------------------------------------------------------------------------
144-- | Send the file contents to /dev/null with exception handling
145toChunksBracket_ :: Handle -> Handle -> IO ()
146toChunksBracket_ inh devNull =
147 let readEx = IP.bracket_
150 (\_ -> IFH.toChunks inh)
151 in S.fold (IFH.writeChunks devNull) $ readEx
154inspect $ hasNoTypeClasses 'toChunksBracket_
155-- inspect $ 'toChunksBracket `hasNoType` ''Step
158toChunksBracket :: Handle -> Handle -> IO ()
159toChunksBracket inh devNull =
160 let readEx = S.bracket
163 (\_ -> IFH.toChunks inh)
164 in S.fold (IFH.writeChunks devNull) $ readEx
166o_1_space_copy_exceptions_toChunks :: BenchEnv -> [Benchmark]
167o_1_space_copy_exceptions_toChunks env =
168 [ bgroup "copy/toChunks/exceptions"
169 [ mkBench "S.bracket_" env $ \inH _ ->
170 toChunksBracket_ inH (nullH env)
171 , mkBench "S.bracket" env $ \inH _ ->
172 toChunksBracket inH (nullH env)
176-------------------------------------------------------------------------------
178-------------------------------------------------------------------------------
181copyStream :: Handle -> Handle -> IO ()
182copyStream inh outh = S.fold (FH.write outh) (S.unfold FH.read inh)
185inspect $ hasNoTypeClasses 'copyStream
186inspect $ 'copyStream `hasNoType` ''Step -- S.unfold
187inspect $ 'copyStream `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
188inspect $ 'copyStream `hasNoType` ''A.ReadUState -- FH.read/A.read
189inspect $ 'copyStream `hasNoType` ''AT.ArrayUnsafe -- FH.write/writeNUnsafe
190inspect $ 'copyStream `hasNoType` ''Strict.Tuple3' -- FH.write/lchunksOf
194copyStreamLatin1 :: Handle -> Handle -> IO ()
195copyStreamLatin1 inh outh =
196 S.fold (FH.write outh)
199 $ S.unfold FH.read inh
202inspect $ hasNoTypeClasses 'copyStreamLatin1
203inspect $ 'copyStreamLatin1 `hasNoType` ''Step
204inspect $ 'copyStreamLatin1 `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
205inspect $ 'copyStreamLatin1 `hasNoType` ''A.ReadUState -- FH.read/A.read
206inspect $ 'copyStreamLatin1 `hasNoType` ''AT.ArrayUnsafe -- FH.write/writeNUnsafe
207inspect $ 'copyStreamLatin1 `hasNoType` ''Strict.Tuple3' -- FH.write/lchunksOf
211_copyStreamUtf8 :: Handle -> Handle -> IO ()
212_copyStreamUtf8 inh outh =
213 S.fold (FH.write outh)
216 $ S.unfold FH.read inh
219inspect $ hasNoTypeClasses '_copyStreamUtf8
220-- inspect $ '_copyStreamUtf8 `hasNoType` ''Step
221-- inspect $ '_copyStreamUtf8 `hasNoType` ''AT.FlattenState
222-- inspect $ '_copyStreamUtf8 `hasNoType` ''D.ConcatMapUState
226copyStreamUtf8Lax :: Handle -> Handle -> IO ()
227copyStreamUtf8Lax inh outh =
228 S.fold (FH.write outh)
231 $ S.unfold FH.read inh
234inspect $ hasNoTypeClasses 'copyStreamUtf8Lax
235-- inspect $ 'copyStreamUtf8Lax `hasNoType` ''Step
236-- inspect $ 'copyStreamUtf8Lax `hasNoType` ''AT.FlattenState
237-- inspect $ 'copyStreamUtf8Lax `hasNoType` ''D.ConcatMapUState
240o_1_space_copy_read :: BenchEnv -> [Benchmark]
241o_1_space_copy_read env =
243 [ mkBench "rawToNull" env $ \inh _ ->
244 copyStream inh (nullH env)
245 , mkBench "rawToFile" env $ \inh outh ->
247 -- This needs an ascii file, as decode just errors out.
248 , mkBench "SS.encodeLatin1 . SS.decodeLatin1" env $ \inh outh ->
249 copyStreamLatin1 inh outh
251 , mkBench "copyUtf8" env $ \inh outh ->
252 _copyStreamUtf8 inh outh
254 , mkBenchSmall "SS.encodeUtf8 . SS.decodeUtf8Lax" env $ \inh outh ->
255 copyStreamUtf8Lax inh outh
259-------------------------------------------------------------------------------
261-------------------------------------------------------------------------------
263-- | Send the file contents to /dev/null
264readFromBytesNull :: Handle -> Handle -> IO ()
265readFromBytesNull inh devNull = IFH.fromBytes devNull $ S.unfold FH.read inh
268inspect $ hasNoTypeClasses 'readFromBytesNull
269inspect $ 'readFromBytesNull `hasNoType` ''Step
270inspect $ 'readFromBytesNull `hasNoType` ''AT.SpliceState
271inspect $ 'readFromBytesNull `hasNoType` ''AT.ArrayUnsafe -- FH.fromBytes/S.arraysOf
272inspect $ 'readFromBytesNull `hasNoType` ''D.GroupState
275o_1_space_copy_fromBytes :: BenchEnv -> [Benchmark]
276o_1_space_copy_fromBytes env =
277 [ bgroup "copy/fromBytes"
278 [ mkBench "rawToNull" env $ \inh _ ->
279 readFromBytesNull inh (nullH env)
283-------------------------------------------------------------------------------
285-------------------------------------------------------------------------------
287-- | Send the file contents to /dev/null with exception handling
288readWriteOnExceptionUnfold :: Handle -> Handle -> IO ()
289readWriteOnExceptionUnfold inh devNull =
290 let readEx = IUF.onException (\_ -> hClose inh) FH.read
291 in S.fold (FH.write devNull) $ S.unfold readEx inh
294inspect $ hasNoTypeClasses 'readWriteOnExceptionUnfold
295-- inspect $ 'readWriteOnExceptionUnfold `hasNoType` ''Step
298-- | Send the file contents to /dev/null with exception handling
299readWriteHandleExceptionUnfold :: Handle -> Handle -> IO ()
300readWriteHandleExceptionUnfold inh devNull =
301 let handler (_e :: SomeException) = hClose inh >> return 10
302 readEx = IUF.handle (IUF.singletonM handler) FH.read
303 in S.fold (FH.write devNull) $ S.unfold readEx inh
306inspect $ hasNoTypeClasses 'readWriteHandleExceptionUnfold
307-- inspect $ 'readWriteHandleExceptionUnfold `hasNoType` ''Step
310-- | Send the file contents to /dev/null with exception handling
311readWriteFinally_Unfold :: Handle -> Handle -> IO ()
312readWriteFinally_Unfold inh devNull =
313 let readEx = IUF.finally_ (\_ -> hClose inh) FH.read
314 in S.fold (FH.write devNull) $ S.unfold readEx inh
317inspect $ hasNoTypeClasses 'readWriteFinally_Unfold
318-- inspect $ 'readWriteFinallyUnfold `hasNoType` ''Step
321readWriteFinallyUnfold :: Handle -> Handle -> IO ()
322readWriteFinallyUnfold inh devNull =
323 let readEx = IUF.finally (\_ -> hClose inh) FH.read
324 in S.fold (FH.write devNull) $ S.unfold readEx inh
326-- | Send the file contents to /dev/null with exception handling
327readWriteBracket_Unfold :: Handle -> Handle -> IO ()
328readWriteBracket_Unfold inh devNull =
329 let readEx = IUF.bracket_ return (\_ -> hClose inh) FH.read
330 in S.fold (FH.write devNull) $ S.unfold readEx inh
333inspect $ hasNoTypeClasses 'readWriteBracket_Unfold
334-- inspect $ 'readWriteBracketUnfold `hasNoType` ''Step
337readWriteBracketUnfold :: Handle -> Handle -> IO ()
338readWriteBracketUnfold inh devNull =
339 let readEx = IUF.bracket return (\_ -> hClose inh) FH.read
340 in S.fold (FH.write devNull) $ S.unfold readEx inh
342o_1_space_copy_read_exceptions :: BenchEnv -> [Benchmark]
343o_1_space_copy_read_exceptions env =
344 [ bgroup "copy/read/exceptions"
345 [ mkBenchSmall "UF.onException" env $ \inh _ ->
346 readWriteOnExceptionUnfold inh (nullH env)
347 , mkBenchSmall "UF.handle" env $ \inh _ ->
348 readWriteHandleExceptionUnfold inh (nullH env)
349 , mkBenchSmall "UF.finally_" env $ \inh _ ->
350 readWriteFinally_Unfold inh (nullH env)
351 , mkBenchSmall "UF.finally" env $ \inh _ ->
352 readWriteFinallyUnfold inh (nullH env)
353 , mkBenchSmall "UF.bracket_" env $ \inh _ ->
354 readWriteBracket_Unfold inh (nullH env)
355 , mkBenchSmall "UF.bracket" env $ \inh _ ->
356 readWriteBracketUnfold inh (nullH env)
360-------------------------------------------------------------------------------
362-------------------------------------------------------------------------------
364-- | Send the file contents to /dev/null with exception handling
365readWriteOnExceptionStream :: Handle -> Handle -> IO ()
366readWriteOnExceptionStream inh devNull =
367 let readEx = S.onException (hClose inh) (S.unfold FH.read inh)
368 in S.fold (FH.write devNull) $ readEx
370-- | Send the file contents to /dev/null with exception handling
371readWriteHandleExceptionStream :: Handle -> Handle -> IO ()
372readWriteHandleExceptionStream inh devNull =
373 let handler (_e :: SomeException) = S.yieldM (hClose inh >> return 10)
374 readEx = S.handle handler (S.unfold FH.read inh)
375 in S.fold (FH.write devNull) $ readEx
377-- | Send the file contents to /dev/null with exception handling
378readWriteFinally_Stream :: Handle -> Handle -> IO ()
379readWriteFinally_Stream inh devNull =
380 let readEx = IP.finally_ (hClose inh) (S.unfold FH.read inh)
381 in S.fold (FH.write devNull) readEx
383readWriteFinallyStream :: Handle -> Handle -> IO ()
384readWriteFinallyStream inh devNull =
385 let readEx = S.finally (hClose inh) (S.unfold FH.read inh)
386 in S.fold (FH.write devNull) readEx
388-- | Send the file contents to /dev/null with exception handling
389fromToBytesBracket_Stream :: Handle -> Handle -> IO ()
390fromToBytesBracket_Stream inh devNull =
391 let readEx = IP.bracket_ (return ()) (\_ -> hClose inh)
392 (\_ -> IFH.toBytes inh)
393 in IFH.fromBytes devNull $ readEx
396inspect $ hasNoTypeClasses 'fromToBytesBracket_Stream
397-- inspect $ 'fromToBytesBracketStream `hasNoType` ''Step
400fromToBytesBracketStream :: Handle -> Handle -> IO ()
401fromToBytesBracketStream inh devNull =
402 let readEx = S.bracket (return ()) (\_ -> hClose inh)
403 (\_ -> IFH.toBytes inh)
404 in IFH.fromBytes devNull $ readEx
406o_1_space_copy_stream_exceptions :: BenchEnv -> [Benchmark]
407o_1_space_copy_stream_exceptions env =
408 [ bgroup "copy/read/exceptions"
409 [ mkBenchSmall "S.onException" env $ \inh _ ->
410 readWriteOnExceptionStream inh (nullH env)
411 , mkBenchSmall "S.handle" env $ \inh _ ->
412 readWriteHandleExceptionStream inh (nullH env)
413 , mkBenchSmall "S.finally_" env $ \inh _ ->
414 readWriteFinally_Stream inh (nullH env)
415 , mkBenchSmall "S.finally" env $ \inh _ ->
416 readWriteFinallyStream inh (nullH env)
418 , bgroup "copy/fromToBytes/exceptions"
419 [ mkBenchSmall "S.bracket_" env $ \inh _ ->
420 fromToBytesBracket_Stream inh (nullH env)
421 , mkBenchSmall "S.bracket" env $ \inh _ ->
422 fromToBytesBracketStream inh (nullH env)
426-------------------------------------------------------------------------------
427-- copy with group/ungroup transformations
428-------------------------------------------------------------------------------
430-- | Lines and unlines
431copyChunksSplitInterposeSuffix :: Handle -> Handle -> IO ()
432copyChunksSplitInterposeSuffix inh outh =
433 S.fold (IFH.write outh)
434 $ AS.interposeSuffix 10
435 $ AS.splitOnSuffix 10
439inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterposeSuffix [''Storable]
440-- inspect $ 'copyChunksSplitInterposeSuffix `hasNoType` ''Step
443-- | Words and unwords
444copyChunksSplitInterpose :: Handle -> Handle -> IO ()
445copyChunksSplitInterpose inh outh =
446 S.fold (IFH.write outh)
448 -- XXX this is not correct word splitting combinator
453inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterpose [''Storable]
454-- inspect $ 'copyChunksSplitInterpose `hasNoType` ''Step
457o_1_space_copy_toChunks_group_ungroup :: BenchEnv -> [Benchmark]
458o_1_space_copy_toChunks_group_ungroup env =
459 [ bgroup "copy/toChunks/group-ungroup"
460 [ mkBench "AS.interposeSuffix . AS.splitOnSuffix" env $ \inh outh ->
461 copyChunksSplitInterposeSuffix inh outh
462 , mkBenchSmall "AS.interpose . AS.splitOn" env $ \inh outh ->
463 copyChunksSplitInterpose inh outh
467-------------------------------------------------------------------------------
468-- copy with group/ungroup transformations
469-------------------------------------------------------------------------------
471linesUnlinesCopy :: Handle -> Handle -> IO ()
472linesUnlinesCopy inh outh =
473 S.fold (FH.write outh)
475 $ IUS.unlines IUF.fromList
476 $ S.splitOnSuffix (== '\n') FL.toList
478 $ S.unfold FH.read inh
480linesUnlinesArrayWord8Copy :: Handle -> Handle -> IO ()
481linesUnlinesArrayWord8Copy inh outh =
482 S.fold (FH.write outh)
483 $ IP.interposeSuffix 10 A.read
484 $ S.splitOnSuffix (== 10) A.write
485 $ S.unfold FH.read inh
487-- XXX splitSuffixOn requires -funfolding-use-threshold=150 for better fusion
488-- | Lines and unlines
489linesUnlinesArrayCharCopy :: Handle -> Handle -> IO ()
490linesUnlinesArrayCharCopy inh outh =
491 S.fold (FH.write outh)
496 $ S.unfold FH.read inh
499inspect $ hasNoTypeClassesExcept 'linesUnlinesArrayCharCopy [''Storable]
500-- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''Step
503-- XXX to write this we need to be able to map decodeUtf8 on the A.read fold.
504-- For that we have to write decodeUtf8 as a Pipe.
506{-# INLINE linesUnlinesArrayUtf8Copy #-}
507linesUnlinesArrayUtf8Copy :: Handle -> Handle -> IO ()
508linesUnlinesArrayUtf8Copy inh outh =
509 S.fold (FH.write outh)
511 $ IP.intercalate (A.fromList [10]) (pipe SS.decodeUtf8P A.read)
512 $ S.splitOnSuffix (== '\n') (IFL.lmap SS.encodeUtf8 A.write)
514 $ S.unfold FH.read inh
517-- | Word, unwords and copy
518wordsUnwordsCopyWord8 :: Handle -> Handle -> IO ()
519wordsUnwordsCopyWord8 inh outh =
520 S.fold (FH.write outh)
521 $ IP.interposeSuffix 32 IUF.fromList
522 $ S.wordsBy isSp FL.toList
523 $ S.unfold FH.read inh
526inspect $ hasNoTypeClasses 'wordsUnwordsCopyWord8
527-- inspect $ 'wordsUnwordsCopyWord8 `hasNoType` ''Step
530-- | Word, unwords and copy
531wordsUnwordsCopy :: Handle -> Handle -> IO ()
532wordsUnwordsCopy inh outh =
533 S.fold (FH.write outh)
535 $ IUS.unwords IUF.fromList
536 -- XXX This pipeline does not fuse with wordsBy but fuses with splitOn
537 -- with -funfolding-use-threshold=300. With wordsBy it does not fuse
538 -- even with high limits for inlining and spec-constr ghc options. With
539 -- -funfolding-use-threshold=400 it performs pretty well and there
540 -- is no evidence in the core that a join point involving Step
541 -- constructors is not getting inlined. Not being able to fuse at all in
542 -- this case could be an unknown issue, need more investigation.
543 $ S.wordsBy isSpace FL.toList
544 -- -- $ S.splitOn isSpace FL.toList
546 $ S.unfold FH.read inh
549-- inspect $ hasNoTypeClasses 'wordsUnwordsCopy
550-- inspect $ 'wordsUnwordsCopy `hasNoType` ''Step
553wordsUnwordsCharArrayCopy :: Handle -> Handle -> IO ()
554wordsUnwordsCharArrayCopy inh outh =
555 S.fold (FH.write outh)
560 $ S.unfold FH.read inh
562o_1_space_copy_read_group_ungroup :: BenchEnv -> [Benchmark]
563o_1_space_copy_read_group_ungroup env =
564 [ bgroup "copy/read/group-ungroup"
565 [ mkBenchSmall "US.unlines . S.splitOnSuffix ([Word8])" env
566 $ \inh outh -> linesUnlinesCopy inh outh
567 , mkBenchSmall "S.interposeSuffix . S.splitOnSuffix(Array Word8)" env
568 $ \inh outh -> linesUnlinesArrayWord8Copy inh outh
569 , mkBenchSmall "UA.unlines . UA.lines (Array Char)" env
570 $ \inh outh -> linesUnlinesArrayCharCopy inh outh
572 , mkBenchSmall "S.interposeSuffix . S.wordsBy ([Word8])" env
573 $ \inh outh -> wordsUnwordsCopyWord8 inh outh
574 , mkBenchSmall "US.unwords . S.wordsBy ([Char])" env
575 $ \inh outh -> wordsUnwordsCopy inh outh
576 , mkBenchSmall "UA.unwords . UA.words (Array Char)" env
577 $ \inh outh -> wordsUnwordsCharArrayCopy inh outh
581-------------------------------------------------------------------------------
583-------------------------------------------------------------------------------
585allBenchmarks :: BenchEnv -> [Benchmark]
586allBenchmarks env = Prelude.concat
587 [ o_1_space_copy_chunked env
588 , o_1_space_copy_exceptions_readChunks env
589 , o_1_space_copy_exceptions_toChunks env
590 , o_1_space_copy_read env
591 , o_1_space_copy_fromBytes env
592 , o_1_space_copy_read_exceptions env
593 , o_1_space_copy_stream_exceptions env
594 , o_1_space_copy_toChunks_group_ungroup env
595 , o_1_space_copy_read_group_ungroup env
keysesc to close
- j k
- move down, up
- enter
- open
- esc
- back, or up a level
- 1 2 3 4
- readme, files, commits, refs
- /
- filter
- y
- copy the clone command
- c
- compare the chosen commit with another (or shift-click both)
- ?
- show or hide this list