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
38 , catOnExceptionStream
47 , linesUnlinesArrayWord8Copy
48 , linesUnlinesArrayCharCopy
49 -- , linesUnlinesArrayUtf8Copy
50 , wordsUnwordsCopyWord8
52 , wordsUnwordsCharArrayCopy
58 , copyCodecUtf8Lenient
60 , parseManyChunksOfSum
73import Control.Exception (SomeException)
74import Data.Char (ord, chr)
75import Data.Word (Word8)
76import System.IO (Handle, hClose)
77import Prelude hiding (last, length)
79import qualified Streamly.FileSystem.Handle as FH
80import qualified Streamly.Internal.FileSystem.Handle as IFH
81import qualified Streamly.Memory.Array as A
82-- import qualified Streamly.Internal.Memory.Array as IA
83import qualified Streamly.Internal.Memory.Array.Types as AT
84import qualified Streamly.Prelude as S
85import qualified Streamly.Data.Fold as FL
86-- import qualified Streamly.Internal.Data.Fold as IFL
87import qualified Streamly.Data.Unicode.Stream as SS
88import qualified Streamly.Internal.Data.Unicode.Stream as IUS
89import qualified Streamly.Internal.Memory.Unicode.Array as IUA
90import qualified Streamly.Internal.Data.Unfold as IUF
91import qualified Streamly.Internal.Data.Parser as PR
92import qualified Streamly.Internal.Prelude as IP
93import qualified Streamly.Internal.Data.Stream.StreamD as D
96import Foreign.Storable (Storable)
97import Streamly.Internal.Data.Stream.StreamD.Type (Step(..), GroupState)
101-- | Get the last byte from a file bytestream.
103last :: Handle -> IO (Maybe Word8)
104last = S.last . S.unfold FH.read
107inspect $ hasNoTypeClasses 'last
108inspect $ 'last `hasNoType` ''Step
109inspect $ 'last `hasNoType` ''AT.FlattenState
110inspect $ 'last `hasNoType` ''D.ConcatMapUState
113-- assert that flattenArrays constructors are not present
114-- | Count the number of bytes in a file.
115{-# INLINE countBytes #-}
116countBytes :: Handle -> IO Int
117countBytes = S.length . S.unfold FH.read
120inspect $ hasNoTypeClasses 'countBytes
121inspect $ 'countBytes `hasNoType` ''Step
122inspect $ 'countBytes `hasNoType` ''AT.FlattenState
123inspect $ 'countBytes `hasNoType` ''D.ConcatMapUState
126-- | Count the number of lines in a file.
127{-# INLINE countLines #-}
128countLines :: Handle -> IO Int
136inspect $ hasNoTypeClasses 'countLines
137inspect $ 'countLines `hasNoType` ''Step
138inspect $ 'countLines `hasNoType` ''AT.FlattenState
139inspect $ 'countLines `hasNoType` ''D.ConcatMapUState
142-- | Count the number of words in a file.
143{-# INLINE countWords #-}
144countWords :: Handle -> IO Int
152inspect $ hasNoTypeClasses 'countWords
153-- inspect $ 'countWords `hasNoType` ''Step
154-- inspect $ 'countWords `hasNoType` ''D.ConcatMapUState
157-- | Count the number of lines in a file.
158{-# INLINE countLinesU #-}
159countLinesU :: Handle -> IO Int
164 $ S.concatUnfold A.read (IFH.toChunks inh)
167inspect $ hasNoTypeClasses 'countLinesU
168inspect $ 'countLinesU `hasNoType` ''Step
169inspect $ 'countLinesU `hasNoType` ''D.ConcatMapUState
172-- | Sum the bytes in a file.
173{-# INLINE sumBytes #-}
174sumBytes :: Handle -> IO Word8
175sumBytes = S.sum . S.unfold FH.read
178inspect $ hasNoTypeClasses 'sumBytes
179inspect $ 'sumBytes `hasNoType` ''Step
180inspect $ 'sumBytes `hasNoType` ''AT.FlattenState
181inspect $ 'sumBytes `hasNoType` ''D.ConcatMapUState
184-- | Send the file contents to /dev/null
186cat :: Handle -> Handle -> IO ()
187cat devNull inh = S.fold (FH.write devNull) $ S.unfold FH.read inh
190inspect $ hasNoTypeClasses 'cat
191inspect $ 'cat `hasNoType` ''Step
192inspect $ 'cat `hasNoType` ''AT.FlattenState
193inspect $ 'cat `hasNoType` ''D.ConcatMapUState
196-- | Send the file contents to /dev/null
197{-# INLINE catStreamWrite #-}
198catStreamWrite :: Handle -> Handle -> IO ()
199catStreamWrite devNull inh = IFH.fromBytes devNull $ S.unfold FH.read inh
202inspect $ hasNoTypeClasses 'catStreamWrite
203inspect $ 'catStreamWrite `hasNoType` ''Step
204inspect $ 'catStreamWrite `hasNoType` ''AT.FlattenState
205inspect $ 'catStreamWrite `hasNoType` ''D.ConcatMapUState
208-- | Send the file contents to /dev/null with exception handling
209{-# INLINE catBracket #-}
210catBracket :: Handle -> Handle -> IO ()
211catBracket devNull inh =
212 let readEx = IUF.bracket return (\_ -> hClose inh) FH.read
213 in S.fold (FH.write devNull) $ S.unfold readEx inh
216inspect $ hasNoTypeClasses 'catBracket
217-- inspect $ 'catBracket `hasNoType` ''Step
218-- inspect $ 'catBracket `hasNoType` ''AT.FlattenState
219-- inspect $ 'catBracket `hasNoType` ''D.ConcatMapUState
222{-# INLINE catBracketIO #-}
223catBracketIO :: Handle -> Handle -> IO ()
224catBracketIO devNull inh =
225 let readEx = IUF.bracketIO return (\_ -> hClose inh) FH.read
226 in S.fold (FH.write devNull) $ S.unfold readEx inh
228-- | Send the file contents to /dev/null with exception handling
229{-# INLINE catBracketStream #-}
230catBracketStream :: Handle -> Handle -> IO ()
231catBracketStream devNull inh =
232 let readEx = S.bracket (return ()) (\_ -> hClose inh)
233 (\_ -> IFH.toBytes inh)
234 in IFH.fromBytes devNull $ readEx
237inspect $ hasNoTypeClasses 'catBracketStream
238-- inspect $ 'catBracketStream `hasNoType` ''Step
241{-# INLINE catBracketStreamIO #-}
242catBracketStreamIO :: Handle -> Handle -> IO ()
243catBracketStreamIO devNull inh =
244 let readEx = IP.bracketIO (return ()) (\_ -> hClose inh)
245 (\_ -> IFH.toBytes inh)
246 in IFH.fromBytes devNull $ readEx
248-- | Send the file contents to /dev/null with exception handling
249{-# INLINE catOnException #-}
250catOnException :: Handle -> Handle -> IO ()
251catOnException devNull inh =
252 let readEx = IUF.onException (\_ -> hClose inh) FH.read
253 in S.fold (FH.write devNull) $ S.unfold readEx inh
256inspect $ hasNoTypeClasses 'catOnException
257-- inspect $ 'catOnException `hasNoType` ''Step
258-- inspect $ 'catOnException `hasNoType` ''AT.FlattenState
259-- inspect $ 'catOnException `hasNoType` ''D.ConcatMapUState
262-- | Send the file contents to /dev/null with exception handling
263{-# INLINE catOnExceptionStream #-}
264catOnExceptionStream :: Handle -> Handle -> IO ()
265catOnExceptionStream devNull inh =
266 let readEx = S.onException (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 catFinally #-}
271catFinally :: Handle -> Handle -> IO ()
272catFinally devNull inh =
273 let readEx = IUF.finally (\_ -> hClose inh) FH.read
274 in S.fold (FH.write devNull) $ S.unfold readEx inh
277inspect $ hasNoTypeClasses 'catFinally
278-- inspect $ 'catFinally `hasNoType` ''Step
279-- inspect $ 'catFinally `hasNoType` ''AT.FlattenState
280-- inspect $ 'catFinally `hasNoType` ''D.ConcatMapUState
283{-# INLINE catFinallyIO #-}
284catFinallyIO :: Handle -> Handle -> IO ()
285catFinallyIO devNull inh =
286 let readEx = IUF.finallyIO (\_ -> hClose inh) FH.read
287 in S.fold (FH.write devNull) $ S.unfold readEx inh
289-- | Send the file contents to /dev/null with exception handling
290{-# INLINE catFinallyStream #-}
291catFinallyStream :: Handle -> Handle -> IO ()
292catFinallyStream devNull inh =
293 let readEx = S.finally (hClose inh) (S.unfold FH.read inh)
294 in S.fold (FH.write devNull) readEx
296{-# INLINE catFinallyStreamIO #-}
297catFinallyStreamIO :: Handle -> Handle -> IO ()
298catFinallyStreamIO devNull inh =
299 let readEx = IP.finallyIO (hClose inh) (S.unfold FH.read inh)
300 in S.fold (FH.write devNull) readEx
302-- | Send the file contents to /dev/null with exception handling
303{-# INLINE catHandle #-}
304catHandle :: Handle -> Handle -> IO ()
305catHandle devNull inh =
306 let handler (_e :: SomeException) = hClose inh >> return 10
307 readEx = IUF.handle (IUF.singletonM handler) FH.read
308 in S.fold (FH.write devNull) $ S.unfold readEx inh
311inspect $ hasNoTypeClasses 'catHandle
312-- inspect $ 'catHandle `hasNoType` ''Step
313-- inspect $ 'catHandle `hasNoType` ''AT.FlattenState
314-- inspect $ 'catHandle `hasNoType` ''D.ConcatMapUState
317-- | Send the file contents to /dev/null with exception handling
318{-# INLINE catHandleStream #-}
319catHandleStream :: Handle -> Handle -> IO ()
320catHandleStream devNull inh =
321 let handler (_e :: SomeException) = S.yieldM (hClose inh >> return 10)
322 readEx = S.handle handler (S.unfold FH.read inh)
323 in S.fold (FH.write devNull) $ readEx
327copy :: Handle -> Handle -> IO ()
328copy inh outh = S.fold (FH.write outh) (S.unfold FH.read inh)
331inspect $ hasNoTypeClasses 'copy
332inspect $ 'copy `hasNoType` ''Step
333inspect $ 'copy `hasNoType` ''AT.FlattenState
334inspect $ 'copy `hasNoType` ''D.ConcatMapUState
337{-# INLINE readWord8 #-}
338readWord8 :: Handle -> IO ()
339readWord8 inh = S.drain $ S.unfold FH.read inh
341{-# INLINE decodeLatin1 #-}
342decodeLatin1 :: Handle -> IO ()
346 $ S.unfold FH.read inh
349{-# INLINE copyCodecChar8 #-}
350copyCodecChar8 :: Handle -> Handle -> IO ()
351copyCodecChar8 inh outh =
352 S.fold (FH.write outh)
355 $ S.unfold FH.read inh
358inspect $ hasNoTypeClasses 'copyCodecChar8
359inspect $ 'copyCodecChar8 `hasNoType` ''Step
360inspect $ 'copyCodecChar8 `hasNoType` ''AT.FlattenState
361inspect $ 'copyCodecChar8 `hasNoType` ''D.ConcatMapUState
364{-# INLINE decodeUtf8Lax #-}
365decodeUtf8Lax :: Handle -> IO ()
369 $ S.unfold FH.read inh
372inspect $ hasNoTypeClasses 'decodeUtf8Lax
373-- inspect $ 'decodeUtf8Lax `hasNoType` ''Step
374-- inspect $ 'decodeUtf8Lax `hasNoType` ''AT.FlattenState
375-- inspect $ 'decodeUtf8Lax `hasNoType` ''D.ConcatMapUState
379{-# INLINE copyCodecUtf8 #-}
380copyCodecUtf8 :: Handle -> Handle -> IO ()
381copyCodecUtf8 inh outh =
382 S.fold (FH.write outh)
385 $ S.unfold FH.read inh
388inspect $ hasNoTypeClasses 'copyCodecUtf8
389-- inspect $ 'copyCodecUtf8 `hasNoType` ''Step
390-- inspect $ 'copyCodecUtf8 `hasNoType` ''AT.FlattenState
391-- inspect $ 'copyCodecUtf8 `hasNoType` ''D.ConcatMapUState
395{-# INLINE copyCodecUtf8Lenient #-}
396copyCodecUtf8Lenient :: Handle -> Handle -> IO ()
397copyCodecUtf8Lenient inh outh =
398 S.fold (FH.write outh)
401 $ S.unfold FH.read inh
404inspect $ hasNoTypeClasses 'copyCodecUtf8Lenient
405-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''Step
406-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''AT.FlattenState
407-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''D.ConcatMapUState
410{-# INLINE chunksOfSum #-}
411chunksOfSum :: Int -> Handle -> IO Int
412chunksOfSum n inh = S.length $ S.chunksOf n FL.sum (S.unfold FH.read inh)
414-- | Slice in chunks of size n and get the count of chunks.
415{-# INLINE chunksOf #-}
416chunksOf :: Int -> Handle -> IO Int
418 -- writeNUnsafe gives 2.5x boost here over writeN.
419 S.length $ S.chunksOf n (AT.writeNUnsafe n) (S.unfold FH.read inh)
422inspect $ hasNoTypeClasses 'chunksOf
423inspect $ 'chunksOf `hasNoType` ''Step
424inspect $ 'chunksOf `hasNoType` ''AT.FlattenState
425inspect $ 'chunksOf `hasNoType` ''D.ConcatMapUState
426inspect $ 'chunksOf `hasNoType` ''GroupState
429-- This is to make sure that the concatMap in FH.read, groupsOf and foldlM'
432-- | Slice in chunks of size n and get the count of chunks.
433{-# INLINE chunksOfD #-}
434chunksOfD :: Int -> Handle -> IO Int
436 D.foldlM' (\i _ -> return $ i + 1) 0
437 $ D.groupsOf n (AT.writeNUnsafe n)
438 $ D.fromStreamK (S.unfold FH.read inh)
441inspect $ hasNoTypeClasses 'chunksOf
442inspect $ 'chunksOf `hasNoType` ''Step
443inspect $ 'chunksOfD `hasNoType` ''GroupState
444inspect $ 'chunksOfD `hasNoType` ''AT.FlattenState
445inspect $ 'chunksOfD `hasNoType` ''D.ConcatMapUState
448{-# INLINE parseManyChunksOfSum #-}
449parseManyChunksOfSum :: Int -> Handle -> IO Int
450parseManyChunksOfSum n inh =
451 S.length $ IP.parseMany (PR.take n FL.sum) (S.unfold FH.read inh)
453{-# INLINE linesUnlinesCopy #-}
454linesUnlinesCopy :: Handle -> Handle -> IO ()
455linesUnlinesCopy inh outh =
456 S.fold (FH.write outh)
458 $ IUS.unlines IUF.fromList
459 $ S.splitOnSuffix (== '\n') FL.toList
461 $ S.unfold FH.read inh
463{-# INLINE linesUnlinesArrayWord8Copy #-}
464linesUnlinesArrayWord8Copy :: Handle -> Handle -> IO ()
465linesUnlinesArrayWord8Copy inh outh =
466 S.fold (FH.write outh)
467 $ IP.interposeSuffix 10 A.read
468 $ S.splitOnSuffix (== 10) A.write
469 $ S.unfold FH.read inh
471-- XXX splitSuffixOn requires -funfolding-use-threshold=150 for better fusion
472-- | Lines and unlines
473{-# INLINE linesUnlinesArrayCharCopy #-}
474linesUnlinesArrayCharCopy :: Handle -> Handle -> IO ()
475linesUnlinesArrayCharCopy inh outh =
476 S.fold (FH.write outh)
481 $ S.unfold FH.read inh
484inspect $ hasNoTypeClassesExcept 'linesUnlinesArrayCharCopy [''Storable]
485-- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''Step
486-- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''AT.FlattenState
487-- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''D.ConcatMapUState
490-- XXX to write this we need to be able to map decodeUtf8 on the A.read fold.
491-- For that we have to write decodeUtf8 as a Pipe.
493{-# INLINE linesUnlinesArrayUtf8Copy #-}
494linesUnlinesArrayUtf8Copy :: Handle -> Handle -> IO ()
495linesUnlinesArrayUtf8Copy inh outh =
496 S.fold (FH.write outh)
498 $ IP.intercalate (A.fromList [10]) (pipe SS.decodeUtf8P A.read)
499 $ S.splitOnSuffix (== '\n') (IFL.lmap SS.encodeUtf8 A.write)
501 $ S.unfold FH.read inh
504foreign import ccall unsafe "u_iswspace"
505 iswspace :: Int -> Int
507-- Code copied from base/Data.Char to INLINE it
508{-# INLINE isSpace #-}
509isSpace :: Char -> Bool
510-- isSpace includes non-breaking space
511-- The magic 0x377 isn't really that magical. As of 2014, all the codepoints
512-- at or below 0x377 have been assigned, so we shouldn't have to worry about
513-- any new spaces appearing below there. It would probably be best to
514-- use branchless ||, but currently the eqLit transformation will undo that,
515-- so we'll do it like this until there's a way around that.
517 | uc <= 0x377 = uc == 32 || uc - 0x9 <= 4 || uc == 0xa0
518 | otherwise = iswspace (ord c) /= 0
520 uc = fromIntegral (ord c) :: Word
524isSp = isSpace . chr . fromIntegral
526-- | Word, unwords and copy
527{-# INLINE wordsUnwordsCopyWord8 #-}
528wordsUnwordsCopyWord8 :: Handle -> Handle -> IO ()
529wordsUnwordsCopyWord8 inh outh =
530 S.fold (FH.write outh)
531 $ IP.interposeSuffix 32 IUF.fromList
532 $ S.wordsBy isSp FL.toList
533 $ S.unfold FH.read inh
536inspect $ hasNoTypeClasses 'wordsUnwordsCopyWord8
537-- inspect $ 'wordsUnwordsCopyWord8 `hasNoType` ''Step
538-- inspect $ 'wordsUnwordsCopyWord8 `hasNoType` ''D.ConcatMapUState
541-- | Word, unwords and copy
542{-# INLINE wordsUnwordsCopy #-}
543wordsUnwordsCopy :: Handle -> Handle -> IO ()
544wordsUnwordsCopy inh outh =
545 S.fold (FH.write outh)
547 $ IUS.unwords IUF.fromList
548 -- XXX This pipeline does not fuse with wordsBy but fuses with splitOn
549 -- with -funfolding-use-threshold=300. With wordsBy it does not fuse
550 -- even with high limits for inlining and spec-constr ghc options. With
551 -- -funfolding-use-threshold=400 it performs pretty well and there
552 -- is no evidence in the core that a join point involving Step
553 -- constructors is not getting inlined. Not being able to fuse at all in
554 -- this case could be an unknown issue, need more investigation.
555 $ S.wordsBy isSpace FL.toList
556 -- -- $ S.splitOn isSpace FL.toList
558 $ S.unfold FH.read inh
561-- inspect $ hasNoTypeClasses 'wordsUnwordsCopy
562-- inspect $ 'wordsUnwordsCopy `hasNoType` ''Step
563-- inspect $ 'wordsUnwordsCopy `hasNoType` ''AT.FlattenState
564-- inspect $ 'wordsUnwordsCopy `hasNoType` ''D.ConcatMapUState
567{-# INLINE wordsUnwordsCharArrayCopy #-}
568wordsUnwordsCharArrayCopy :: Handle -> Handle -> IO ()
569wordsUnwordsCharArrayCopy inh outh =
570 S.fold (FH.write outh)
575 $ S.unfold FH.read inh
578lf = fromIntegral (ord '\n')
580toarr :: String -> A.Array Word8
581toarr = A.fromList . map (fromIntegral . ord)
583-- | Split on line feed.
584{-# INLINE splitOn #-}
585splitOn :: Handle -> IO Int
587 (S.length $ S.splitOn (== lf) FL.drain
588 $ S.unfold FH.read inh) -- >>= print
591inspect $ hasNoTypeClasses 'splitOn
592inspect $ 'splitOn `hasNoType` ''Step
593inspect $ 'splitOn `hasNoType` ''AT.FlattenState
594inspect $ 'splitOn `hasNoType` ''D.ConcatMapUState
597-- | Split suffix on line feed.
598{-# INLINE splitOnSuffix #-}
599splitOnSuffix :: Handle -> IO Int
601 (S.length $ S.splitOnSuffix (== lf) FL.drain
602 $ S.unfold FH.read inh) -- >>= print
605inspect $ hasNoTypeClasses 'splitOnSuffix
606inspect $ 'splitOnSuffix `hasNoType` ''Step
607inspect $ 'splitOnSuffix `hasNoType` ''AT.FlattenState
608inspect $ 'splitOnSuffix `hasNoType` ''D.ConcatMapUState
611-- | Split on line feed.
612{-# INLINE parseManySepBy #-}
613parseManySepBy :: Handle -> IO Int
615 (S.length $ IP.parseMany (PR.sliceSepBy (== lf) FL.drain)
616 (S.unfold FH.read inh)) -- >>= print
619{-# INLINE wordsBy #-}
620wordsBy :: Handle -> IO Int
622 (S.length $ S.wordsBy isSp FL.drain
623 $ S.unfold FH.read inh) -- >>= print
626inspect $ hasNoTypeClasses 'wordsBy
627inspect $ 'wordsBy `hasNoType` ''Step
628inspect $ 'wordsBy `hasNoType` ''AT.FlattenState
629inspect $ 'wordsBy `hasNoType` ''D.ConcatMapUState
632-- | Split on a word8 sequence.
633{-# INLINE splitOnSeq #-}
634splitOnSeq :: String -> Handle -> IO Int
636 (S.length $ IP.splitOnSeq (toarr str) FL.drain
637 $ S.unfold FH.read inh) -- >>= print
640-- inspect $ hasNoTypeClasses 'splitOnSeq
641-- inspect $ 'splitOnSeq `hasNoType` ''Step
642-- inspect $ 'splitOnSeq `hasNoType` ''AT.FlattenState
643-- inspect $ 'splitOnSeq `hasNoType` ''D.ConcatMapUState
646-- | Split on a character sequence.
647{-# INLINE splitOnSeqUtf8 #-}
648splitOnSeqUtf8 :: String -> Handle -> IO Int
649splitOnSeqUtf8 str inh =
650 (S.length $ IP.splitOnSeq (A.fromList str) FL.drain
651 $ IUS.decodeUtf8ArraysLenient
652 $ IFH.toChunks inh) -- >>= print
654-- | Split on suffix sequence.
655{-# INLINE splitOnSuffixSeq #-}
656splitOnSuffixSeq :: String -> Handle -> IO Int
657splitOnSuffixSeq str inh =
658 (S.length $ IP.splitOnSuffixSeq (toarr str) FL.drain
659 $ S.unfold FH.read inh) -- >>= print
662-- inspect $ hasNoTypeClasses 'splitOnSuffixSeq
663-- inspect $ 'splitOnSuffixSeq `hasNoType` ''Step
664-- inspect $ 'splitOnSuffixSeq `hasNoType` ''AT.FlattenState
665-- 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