2-- Module : Streamly.Benchmark.FileIO.Stream
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 Streamly.Benchmark.FileIO.Stream
36 , catOnExceptionStream
43 , linesUnlinesArrayWord8Copy
44 , linesUnlinesArrayCharCopy
45 -- , linesUnlinesArrayUtf8Copy
46 , wordsUnwordsCopyWord8
48 , wordsUnwordsCharArrayCopy
54 , copyCodecUtf8Lenient
66import Control.Exception (SomeException)
67import Data.Char (ord, chr)
68import Data.Word (Word8)
69import System.IO (Handle, hClose)
70import Prelude hiding (last, length)
72import qualified Streamly.FileSystem.Handle as FH
73import qualified Streamly.Internal.FileSystem.Handle as IFH
74import qualified Streamly.Memory.Array as A
75-- import qualified Streamly.Internal.Memory.Array as IA
76import qualified Streamly.Internal.Memory.Array.Types as AT
77import qualified Streamly.Prelude as S
78import qualified Streamly.Data.Fold as FL
79-- import qualified Streamly.Internal.Data.Fold as IFL
80import qualified Streamly.Data.Unicode.Stream as SS
81import qualified Streamly.Internal.Data.Unicode.Stream as IUS
82import qualified Streamly.Internal.Memory.Unicode.Array as IUA
83import qualified Streamly.Internal.Data.Unfold as IUF
84import qualified Streamly.Internal.Prelude as IP
85import qualified Streamly.Streams.StreamD as D
88import Foreign.Storable (Storable)
89import Streamly.Streams.StreamD.Type (Step(..), GroupState)
93-- | Get the last byte from a file bytestream.
95last :: Handle -> IO (Maybe Word8)
96last = S.last . S.unfold FH.read
99inspect $ hasNoTypeClasses 'last
100inspect $ 'last `hasNoType` ''Step
101inspect $ 'last `hasNoType` ''AT.FlattenState
102inspect $ 'last `hasNoType` ''D.ConcatMapUState
105-- assert that flattenArrays constructors are not present
106-- | Count the number of bytes in a file.
107{-# INLINE countBytes #-}
108countBytes :: Handle -> IO Int
109countBytes = S.length . S.unfold FH.read
112inspect $ hasNoTypeClasses 'countBytes
113inspect $ 'countBytes `hasNoType` ''Step
114inspect $ 'countBytes `hasNoType` ''AT.FlattenState
115inspect $ 'countBytes `hasNoType` ''D.ConcatMapUState
118-- | Count the number of lines in a file.
119{-# INLINE countLines #-}
120countLines :: Handle -> IO Int
128inspect $ hasNoTypeClasses 'countLines
129inspect $ 'countLines `hasNoType` ''Step
130inspect $ 'countLines `hasNoType` ''AT.FlattenState
131inspect $ 'countLines `hasNoType` ''D.ConcatMapUState
134-- | Count the number of words in a file.
135{-# INLINE countWords #-}
136countWords :: Handle -> IO Int
144inspect $ hasNoTypeClasses 'countWords
145-- inspect $ 'countWords `hasNoType` ''Step
146-- inspect $ 'countWords `hasNoType` ''D.ConcatMapUState
149-- | Count the number of lines in a file.
150{-# INLINE countLinesU #-}
151countLinesU :: Handle -> IO Int
156 $ S.concatUnfold A.read (IFH.toChunks inh)
159inspect $ hasNoTypeClasses 'countLinesU
160inspect $ 'countLinesU `hasNoType` ''Step
161inspect $ 'countLinesU `hasNoType` ''D.ConcatMapUState
164-- | Sum the bytes in a file.
165{-# INLINE sumBytes #-}
166sumBytes :: Handle -> IO Word8
167sumBytes = S.sum . S.unfold FH.read
170inspect $ hasNoTypeClasses 'sumBytes
171inspect $ 'sumBytes `hasNoType` ''Step
172inspect $ 'sumBytes `hasNoType` ''AT.FlattenState
173inspect $ 'sumBytes `hasNoType` ''D.ConcatMapUState
176-- | Send the file contents to /dev/null
178cat :: Handle -> Handle -> IO ()
179cat devNull inh = S.fold (FH.write devNull) $ S.unfold FH.read inh
182inspect $ hasNoTypeClasses 'cat
183inspect $ 'cat `hasNoType` ''Step
184inspect $ 'cat `hasNoType` ''AT.FlattenState
185inspect $ 'cat `hasNoType` ''D.ConcatMapUState
188-- | Send the file contents to /dev/null
189{-# INLINE catStreamWrite #-}
190catStreamWrite :: Handle -> Handle -> IO ()
191catStreamWrite devNull inh = IFH.fromStream devNull $ S.unfold FH.read inh
194inspect $ hasNoTypeClasses 'catStreamWrite
195inspect $ 'catStreamWrite `hasNoType` ''Step
196inspect $ 'catStreamWrite `hasNoType` ''AT.FlattenState
197inspect $ 'catStreamWrite `hasNoType` ''D.ConcatMapUState
200-- | Send the file contents to /dev/null with exception handling
201{-# INLINE catBracket #-}
202catBracket :: Handle -> Handle -> IO ()
203catBracket devNull inh =
204 let readEx = IUF.bracket return (\_ -> hClose inh) FH.read
205 in S.fold (FH.write devNull) $ S.unfold readEx inh
208inspect $ hasNoTypeClasses 'catBracket
209-- inspect $ 'catBracket `hasNoType` ''Step
210-- inspect $ 'catBracket `hasNoType` ''AT.FlattenState
211-- inspect $ 'catBracket `hasNoType` ''D.ConcatMapUState
214-- | Send the file contents to /dev/null with exception handling
215{-# INLINE catBracketStream #-}
216catBracketStream :: Handle -> Handle -> IO ()
217catBracketStream devNull inh =
218 let readEx = S.bracket (return ()) (\_ -> hClose inh)
219 (\_ -> IFH.toStream inh)
220 in IFH.fromStream devNull $ readEx
223inspect $ hasNoTypeClasses 'catBracketStream
224-- inspect $ 'catBracketStream `hasNoType` ''Step
227-- | Send the file contents to /dev/null with exception handling
228{-# INLINE catOnException #-}
229catOnException :: Handle -> Handle -> IO ()
230catOnException devNull inh =
231 let readEx = IUF.onException (\_ -> hClose inh) FH.read
232 in S.fold (FH.write devNull) $ S.unfold readEx inh
235inspect $ hasNoTypeClasses 'catOnException
236-- inspect $ 'catOnException `hasNoType` ''Step
237-- inspect $ 'catOnException `hasNoType` ''AT.FlattenState
238-- inspect $ 'catOnException `hasNoType` ''D.ConcatMapUState
241-- | Send the file contents to /dev/null with exception handling
242{-# INLINE catOnExceptionStream #-}
243catOnExceptionStream :: Handle -> Handle -> IO ()
244catOnExceptionStream devNull inh =
245 let readEx = S.onException (hClose inh) (S.unfold FH.read inh)
246 in S.fold (FH.write devNull) $ readEx
248-- | Send the file contents to /dev/null with exception handling
249{-# INLINE catFinally #-}
250catFinally :: Handle -> Handle -> IO ()
251catFinally devNull inh =
252 let readEx = IUF.finally (\_ -> hClose inh) FH.read
253 in S.fold (FH.write devNull) $ S.unfold readEx inh
256inspect $ hasNoTypeClasses 'catFinally
257-- inspect $ 'catFinally `hasNoType` ''Step
258-- inspect $ 'catFinally `hasNoType` ''AT.FlattenState
259-- inspect $ 'catFinally `hasNoType` ''D.ConcatMapUState
262-- | Send the file contents to /dev/null with exception handling
263{-# INLINE catFinallyStream #-}
264catFinallyStream :: Handle -> Handle -> IO ()
265catFinallyStream devNull inh =
266 let readEx = S.finally (hClose inh) (S.unfold FH.read inh)
267 in S.fold (FH.write devNull) readEx
269-- | Send the file contents to /dev/null with exception handling
270{-# INLINE catHandle #-}
271catHandle :: Handle -> Handle -> IO ()
272catHandle devNull inh =
273 let handler (_e :: SomeException) = hClose inh >> return 10
274 readEx = IUF.handle (IUF.singleton handler) FH.read
275 in S.fold (FH.write devNull) $ S.unfold readEx inh
278inspect $ hasNoTypeClasses 'catHandle
279-- inspect $ 'catHandle `hasNoType` ''Step
280-- inspect $ 'catHandle `hasNoType` ''AT.FlattenState
281-- inspect $ 'catHandle `hasNoType` ''D.ConcatMapUState
284-- | Send the file contents to /dev/null with exception handling
285{-# INLINE catHandleStream #-}
286catHandleStream :: Handle -> Handle -> IO ()
287catHandleStream devNull inh =
288 let handler (_e :: SomeException) = S.yieldM (hClose inh >> return 10)
289 readEx = S.handle handler (S.unfold FH.read inh)
290 in S.fold (FH.write devNull) $ readEx
294copy :: Handle -> Handle -> IO ()
295copy inh outh = S.fold (FH.write outh) (S.unfold FH.read inh)
298inspect $ hasNoTypeClasses 'copy
299inspect $ 'copy `hasNoType` ''Step
300inspect $ 'copy `hasNoType` ''AT.FlattenState
301inspect $ 'copy `hasNoType` ''D.ConcatMapUState
304{-# INLINE readWord8 #-}
305readWord8 :: Handle -> IO ()
306readWord8 inh = S.drain $ S.unfold FH.read inh
308{-# INLINE decodeLatin1 #-}
309decodeLatin1 :: Handle -> IO ()
313 $ S.unfold FH.read inh
316{-# INLINE copyCodecChar8 #-}
317copyCodecChar8 :: Handle -> Handle -> IO ()
318copyCodecChar8 inh outh =
319 S.fold (FH.write outh)
322 $ S.unfold FH.read inh
325inspect $ hasNoTypeClasses 'copyCodecChar8
326inspect $ 'copyCodecChar8 `hasNoType` ''Step
327inspect $ 'copyCodecChar8 `hasNoType` ''AT.FlattenState
328inspect $ 'copyCodecChar8 `hasNoType` ''D.ConcatMapUState
331{-# INLINE decodeUtf8Lax #-}
332decodeUtf8Lax :: Handle -> IO ()
336 $ S.unfold FH.read inh
339inspect $ hasNoTypeClasses 'decodeUtf8Lax
340-- inspect $ 'decodeUtf8Lax `hasNoType` ''Step
341-- inspect $ 'decodeUtf8Lax `hasNoType` ''AT.FlattenState
342-- inspect $ 'decodeUtf8Lax `hasNoType` ''D.ConcatMapUState
346{-# INLINE copyCodecUtf8 #-}
347copyCodecUtf8 :: Handle -> Handle -> IO ()
348copyCodecUtf8 inh outh =
349 S.fold (FH.write outh)
352 $ S.unfold FH.read inh
355inspect $ hasNoTypeClasses 'copyCodecUtf8
356-- inspect $ 'copyCodecUtf8 `hasNoType` ''Step
357-- inspect $ 'copyCodecUtf8 `hasNoType` ''AT.FlattenState
358-- inspect $ 'copyCodecUtf8 `hasNoType` ''D.ConcatMapUState
362{-# INLINE copyCodecUtf8Lenient #-}
363copyCodecUtf8Lenient :: Handle -> Handle -> IO ()
364copyCodecUtf8Lenient inh outh =
365 S.fold (FH.write outh)
368 $ S.unfold FH.read inh
371inspect $ hasNoTypeClasses 'copyCodecUtf8Lenient
372-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''Step
373-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''AT.FlattenState
374-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''D.ConcatMapUState
377-- | Slice in chunks of size n and get the count of chunks.
378{-# INLINE chunksOf #-}
379chunksOf :: Int -> Handle -> IO Int
381 -- writeNUnsafe gives 2.5x boost here over writeN.
382 S.length $ S.chunksOf n (AT.writeNUnsafe n) (S.unfold FH.read inh)
385inspect $ hasNoTypeClasses 'chunksOf
386inspect $ 'chunksOf `hasNoType` ''Step
387inspect $ 'chunksOf `hasNoType` ''AT.FlattenState
388inspect $ 'chunksOf `hasNoType` ''D.ConcatMapUState
389inspect $ 'chunksOf `hasNoType` ''GroupState
392-- This is to make sure that the concatMap in FH.read, groupsOf and foldlM'
395-- | Slice in chunks of size n and get the count of chunks.
396{-# INLINE chunksOfD #-}
397chunksOfD :: Int -> Handle -> IO Int
399 D.foldlM' (\i _ -> return $ i + 1) 0
400 $ D.groupsOf n (AT.writeNUnsafe n)
401 $ D.fromStreamK (S.unfold FH.read inh)
404inspect $ hasNoTypeClasses 'chunksOf
405inspect $ 'chunksOf `hasNoType` ''Step
406inspect $ 'chunksOfD `hasNoType` ''GroupState
407inspect $ 'chunksOfD `hasNoType` ''AT.FlattenState
408inspect $ 'chunksOfD `hasNoType` ''D.ConcatMapUState
411{-# INLINE linesUnlinesCopy #-}
412linesUnlinesCopy :: Handle -> Handle -> IO ()
413linesUnlinesCopy inh outh =
414 S.fold (FH.write outh)
416 $ IUS.unlines IUF.fromList
417 $ S.splitOnSuffix (== '\n') FL.toList
419 $ S.unfold FH.read inh
421{-# INLINE linesUnlinesArrayWord8Copy #-}
422linesUnlinesArrayWord8Copy :: Handle -> Handle -> IO ()
423linesUnlinesArrayWord8Copy inh outh =
424 S.fold (FH.write outh)
425 $ IP.interposeSuffix 10 A.read
426 $ S.splitOnSuffix (== 10) A.write
427 $ S.unfold FH.read inh
429-- XXX splitSuffixOn requires -funfolding-use-threshold=150 for better fusion
430-- | Lines and unlines
431{-# INLINE linesUnlinesArrayCharCopy #-}
432linesUnlinesArrayCharCopy :: Handle -> Handle -> IO ()
433linesUnlinesArrayCharCopy inh outh =
434 S.fold (FH.write outh)
439 $ S.unfold FH.read inh
442inspect $ hasNoTypeClassesExcept 'linesUnlinesArrayCharCopy [''Storable]
443-- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''Step
444-- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''AT.FlattenState
445-- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''D.ConcatMapUState
448-- XXX to write this we need to be able to map decodeUtf8 on the A.read fold.
449-- For that we have to write decodeUtf8 as a Pipe.
451{-# INLINE linesUnlinesArrayUtf8Copy #-}
452linesUnlinesArrayUtf8Copy :: Handle -> Handle -> IO ()
453linesUnlinesArrayUtf8Copy inh outh =
454 S.fold (FH.write outh)
456 $ IP.intercalate (A.fromList [10]) (pipe SS.decodeUtf8P A.read)
457 $ S.splitOnSuffix (== '\n') (IFL.lmap SS.encodeUtf8 A.write)
459 $ S.unfold FH.read inh
462foreign import ccall unsafe "u_iswspace"
463 iswspace :: Int -> Int
465-- Code copied from base/Data.Char to INLINE it
466{-# INLINE isSpace #-}
467isSpace :: Char -> Bool
468-- isSpace includes non-breaking space
469-- The magic 0x377 isn't really that magical. As of 2014, all the codepoints
470-- at or below 0x377 have been assigned, so we shouldn't have to worry about
471-- any new spaces appearing below there. It would probably be best to
472-- use branchless ||, but currently the eqLit transformation will undo that,
473-- so we'll do it like this until there's a way around that.
475 | uc <= 0x377 = uc == 32 || uc - 0x9 <= 4 || uc == 0xa0
476 | otherwise = iswspace (ord c) /= 0
478 uc = fromIntegral (ord c) :: Word
482isSp = isSpace . chr . fromIntegral
484-- | Word, unwords and copy
485{-# INLINE wordsUnwordsCopyWord8 #-}
486wordsUnwordsCopyWord8 :: Handle -> Handle -> IO ()
487wordsUnwordsCopyWord8 inh outh =
488 S.fold (FH.write outh)
489 $ IP.interposeSuffix 32 IUF.fromList
490 $ S.wordsBy isSp FL.toList
491 $ S.unfold FH.read inh
494inspect $ hasNoTypeClasses 'wordsUnwordsCopyWord8
495-- inspect $ 'wordsUnwordsCopyWord8 `hasNoType` ''Step
496-- inspect $ 'wordsUnwordsCopyWord8 `hasNoType` ''D.ConcatMapUState
499-- | Word, unwords and copy
500{-# INLINE wordsUnwordsCopy #-}
501wordsUnwordsCopy :: Handle -> Handle -> IO ()
502wordsUnwordsCopy inh outh =
503 S.fold (FH.write outh)
505 $ IUS.unwords IUF.fromList
506 -- XXX This pipeline does not fuse with wordsBy but fuses with splitOn
507 -- with -funfolding-use-threshold=300. With wordsBy it does not fuse
508 -- even with high limits for inlining and spec-constr ghc options. With
509 -- -funfolding-use-threshold=400 it performs pretty well and there
510 -- is no evidence in the core that a join point involving Step
511 -- constructors is not getting inlined. Not being able to fuse at all in
512 -- this case could be an unknown issue, need more investigation.
513 $ S.wordsBy isSpace FL.toList
514 -- -- $ S.splitOn isSpace FL.toList
516 $ S.unfold FH.read inh
519-- inspect $ hasNoTypeClasses 'wordsUnwordsCopy
520-- inspect $ 'wordsUnwordsCopy `hasNoType` ''Step
521-- inspect $ 'wordsUnwordsCopy `hasNoType` ''AT.FlattenState
522-- inspect $ 'wordsUnwordsCopy `hasNoType` ''D.ConcatMapUState
525{-# INLINE wordsUnwordsCharArrayCopy #-}
526wordsUnwordsCharArrayCopy :: Handle -> Handle -> IO ()
527wordsUnwordsCharArrayCopy inh outh =
528 S.fold (FH.write outh)
533 $ S.unfold FH.read inh
536lf = fromIntegral (ord '\n')
538toarr :: String -> A.Array Word8
539toarr = A.fromList . map (fromIntegral . ord)
541-- | Split on line feed.
542{-# INLINE splitOn #-}
543splitOn :: Handle -> IO Int
545 (S.length $ S.splitOn (== lf) FL.drain
546 $ S.unfold FH.read inh) -- >>= print
549inspect $ hasNoTypeClasses 'splitOn
550inspect $ 'splitOn `hasNoType` ''Step
551inspect $ 'splitOn `hasNoType` ''AT.FlattenState
552inspect $ 'splitOn `hasNoType` ''D.ConcatMapUState
555-- | Split suffix on line feed.
556{-# INLINE splitOnSuffix #-}
557splitOnSuffix :: Handle -> IO Int
559 (S.length $ S.splitOnSuffix (== lf) FL.drain
560 $ S.unfold FH.read inh) -- >>= print
563inspect $ hasNoTypeClasses 'splitOnSuffix
564inspect $ 'splitOnSuffix `hasNoType` ''Step
565inspect $ 'splitOnSuffix `hasNoType` ''AT.FlattenState
566inspect $ 'splitOnSuffix `hasNoType` ''D.ConcatMapUState
570{-# INLINE wordsBy #-}
571wordsBy :: Handle -> IO Int
573 (S.length $ S.wordsBy isSp FL.drain
574 $ S.unfold FH.read inh) -- >>= print
577inspect $ hasNoTypeClasses 'wordsBy
578inspect $ 'wordsBy `hasNoType` ''Step
579inspect $ 'wordsBy `hasNoType` ''AT.FlattenState
580inspect $ 'wordsBy `hasNoType` ''D.ConcatMapUState
583-- | Split on a word8 sequence.
584{-# INLINE splitOnSeq #-}
585splitOnSeq :: String -> Handle -> IO Int
587 (S.length $ IP.splitOnSeq (toarr str) FL.drain
588 $ S.unfold FH.read inh) -- >>= print
591inspect $ hasNoTypeClasses 'splitOnSeq
592-- inspect $ 'splitOnSeq `hasNoType` ''Step
593-- inspect $ 'splitOnSeq `hasNoType` ''AT.FlattenState
594-- inspect $ 'splitOnSeq `hasNoType` ''D.ConcatMapUState
597-- | Split on a character sequence.
598{-# INLINE splitOnSeqUtf8 #-}
599splitOnSeqUtf8 :: String -> Handle -> IO Int
600splitOnSeqUtf8 str inh =
601 (S.length $ IP.splitOnSeq (A.fromList str) FL.drain
602 $ IUS.decodeUtf8ArraysLenient
603 $ IFH.toChunks inh) -- >>= print
605-- | Split on suffix sequence.
606{-# INLINE splitOnSuffixSeq #-}
607splitOnSuffixSeq :: String -> Handle -> IO Int
608splitOnSuffixSeq str inh =
609 (S.length $ IP.splitOnSuffixSeq (toarr str) FL.drain
610 $ S.unfold FH.read inh) -- >>= print
613inspect $ hasNoTypeClasses 'splitOnSuffixSeq
614-- inspect $ 'splitOnSuffixSeq `hasNoType` ''Step
615-- inspect $ 'splitOnSuffixSeq `hasNoType` ''AT.FlattenState
616-- inspect $ 'splitOnSuffixSeq `hasNoType` ''D.ConcatMapUState
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