2-- Module : Streamly.Benchmark.FileIO.Stream
3-- Copyright : (c) 2019 Composewell Technologies
6-- Maintainer : harendra.kumar@gmail.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.String as SS
81import qualified Streamly.Internal.Data.Unfold as IUF
82import qualified Streamly.Internal.Prelude as IP
83import qualified Streamly.Streams.StreamD as D
86import Foreign.Storable (Storable)
87import Streamly.Streams.StreamD.Type (Step(..), GroupState)
91-- | Get the last byte from a file bytestream.
93last :: Handle -> IO (Maybe Word8)
94last = S.last . S.unfold FH.read
97inspect $ hasNoTypeClasses 'last
98inspect $ 'last `hasNoType` ''Step
99inspect $ 'last `hasNoType` ''AT.FlattenState
100inspect $ 'last `hasNoType` ''D.ConcatMapUState
103-- assert that flattenArrays constructors are not present
104-- | Count the number of bytes in a file.
105{-# INLINE countBytes #-}
106countBytes :: Handle -> IO Int
107countBytes = S.length . S.unfold FH.read
110inspect $ hasNoTypeClasses 'countBytes
111inspect $ 'countBytes `hasNoType` ''Step
112inspect $ 'countBytes `hasNoType` ''AT.FlattenState
113inspect $ 'countBytes `hasNoType` ''D.ConcatMapUState
116-- | Count the number of lines in a file.
117{-# INLINE countLines #-}
118countLines :: Handle -> IO Int
121 . SS.foldLines FL.drain
126inspect $ hasNoTypeClasses 'countLines
127inspect $ 'countLines `hasNoType` ''Step
128inspect $ 'countLines `hasNoType` ''AT.FlattenState
129inspect $ 'countLines `hasNoType` ''D.ConcatMapUState
132-- | Count the number of words in a file.
133{-# INLINE countWords #-}
134countWords :: Handle -> IO Int
137 . SS.foldWords FL.drain
142inspect $ hasNoTypeClasses 'countWords
143-- inspect $ 'countWords `hasNoType` ''Step
144-- inspect $ 'countWords `hasNoType` ''D.ConcatMapUState
147-- | Count the number of lines in a file.
148{-# INLINE countLinesU #-}
149countLinesU :: Handle -> IO Int
152 $ SS.foldLines FL.drain
154 $ S.concatUnfold A.read (IFH.toStreamArrays inh)
157inspect $ hasNoTypeClasses 'countLinesU
158inspect $ 'countLinesU `hasNoType` ''Step
159inspect $ 'countLinesU `hasNoType` ''D.ConcatMapUState
162-- | Sum the bytes in a file.
163{-# INLINE sumBytes #-}
164sumBytes :: Handle -> IO Word8
165sumBytes = S.sum . S.unfold FH.read
168inspect $ hasNoTypeClasses 'sumBytes
169inspect $ 'sumBytes `hasNoType` ''Step
170inspect $ 'sumBytes `hasNoType` ''AT.FlattenState
171inspect $ 'sumBytes `hasNoType` ''D.ConcatMapUState
174-- | Send the file contents to /dev/null
176cat :: Handle -> Handle -> IO ()
177cat devNull inh = S.fold (FH.write devNull) $ S.unfold FH.read inh
180inspect $ hasNoTypeClasses 'cat
181inspect $ 'cat `hasNoType` ''Step
182inspect $ 'cat `hasNoType` ''AT.FlattenState
183inspect $ 'cat `hasNoType` ''D.ConcatMapUState
186-- | Send the file contents to /dev/null
187{-# INLINE catStreamWrite #-}
188catStreamWrite :: Handle -> Handle -> IO ()
189catStreamWrite devNull inh = IFH.fromStream devNull $ S.unfold FH.read inh
192inspect $ hasNoTypeClasses 'catStreamWrite
193inspect $ 'catStreamWrite `hasNoType` ''Step
194inspect $ 'catStreamWrite `hasNoType` ''AT.FlattenState
195inspect $ 'catStreamWrite `hasNoType` ''D.ConcatMapUState
198-- | Send the file contents to /dev/null with exception handling
199{-# INLINE catBracket #-}
200catBracket :: Handle -> Handle -> IO ()
201catBracket devNull inh =
202 let readEx = IUF.bracket return (\_ -> hClose inh) FH.read
203 in S.fold (FH.write devNull) $ S.unfold readEx inh
206inspect $ hasNoTypeClasses 'catBracket
207-- inspect $ 'catBracket `hasNoType` ''Step
208-- inspect $ 'catBracket `hasNoType` ''AT.FlattenState
209-- inspect $ 'catBracket `hasNoType` ''D.ConcatMapUState
212-- | Send the file contents to /dev/null with exception handling
213{-# INLINE catBracketStream #-}
214catBracketStream :: Handle -> Handle -> IO ()
215catBracketStream devNull inh =
216 let readEx = S.bracket (return ()) (\_ -> hClose inh)
217 (\_ -> IFH.toStream inh)
218 in IFH.fromStream devNull $ readEx
221inspect $ hasNoTypeClasses 'catBracketStream
222-- inspect $ 'catBracketStream `hasNoType` ''Step
225-- | Send the file contents to /dev/null with exception handling
226{-# INLINE catOnException #-}
227catOnException :: Handle -> Handle -> IO ()
228catOnException devNull inh =
229 let readEx = IUF.onException (\_ -> hClose inh) FH.read
230 in S.fold (FH.write devNull) $ S.unfold readEx inh
233inspect $ hasNoTypeClasses 'catOnException
234-- inspect $ 'catOnException `hasNoType` ''Step
235-- inspect $ 'catOnException `hasNoType` ''AT.FlattenState
236-- inspect $ 'catOnException `hasNoType` ''D.ConcatMapUState
239-- | Send the file contents to /dev/null with exception handling
240{-# INLINE catOnExceptionStream #-}
241catOnExceptionStream :: Handle -> Handle -> IO ()
242catOnExceptionStream devNull inh =
243 let readEx = S.onException (hClose inh) (S.unfold FH.read inh)
244 in S.fold (FH.write devNull) $ readEx
246-- | Send the file contents to /dev/null with exception handling
247{-# INLINE catFinally #-}
248catFinally :: Handle -> Handle -> IO ()
249catFinally devNull inh =
250 let readEx = IUF.finally (\_ -> hClose inh) FH.read
251 in S.fold (FH.write devNull) $ S.unfold readEx inh
254inspect $ hasNoTypeClasses 'catFinally
255-- inspect $ 'catFinally `hasNoType` ''Step
256-- inspect $ 'catFinally `hasNoType` ''AT.FlattenState
257-- inspect $ 'catFinally `hasNoType` ''D.ConcatMapUState
260-- | Send the file contents to /dev/null with exception handling
261{-# INLINE catFinallyStream #-}
262catFinallyStream :: Handle -> Handle -> IO ()
263catFinallyStream devNull inh =
264 let readEx = S.finally (hClose inh) (S.unfold FH.read inh)
265 in S.fold (FH.write devNull) readEx
267-- | Send the file contents to /dev/null with exception handling
268{-# INLINE catHandle #-}
269catHandle :: Handle -> Handle -> IO ()
270catHandle devNull inh =
271 let handler (_e :: SomeException) = hClose inh >> return 10
272 readEx = IUF.handle (IUF.singleton handler) FH.read
273 in S.fold (FH.write devNull) $ S.unfold readEx inh
276inspect $ hasNoTypeClasses 'catHandle
277-- inspect $ 'catHandle `hasNoType` ''Step
278-- inspect $ 'catHandle `hasNoType` ''AT.FlattenState
279-- inspect $ 'catHandle `hasNoType` ''D.ConcatMapUState
282-- | Send the file contents to /dev/null with exception handling
283{-# INLINE catHandleStream #-}
284catHandleStream :: Handle -> Handle -> IO ()
285catHandleStream devNull inh =
286 let handler (_e :: SomeException) = S.yieldM (hClose inh >> return 10)
287 readEx = S.handle handler (S.unfold FH.read inh)
288 in S.fold (FH.write devNull) $ readEx
292copy :: Handle -> Handle -> IO ()
293copy inh outh = S.fold (FH.write outh) (S.unfold FH.read inh)
296inspect $ hasNoTypeClasses 'copy
297inspect $ 'copy `hasNoType` ''Step
298inspect $ 'copy `hasNoType` ''AT.FlattenState
299inspect $ 'copy `hasNoType` ''D.ConcatMapUState
302{-# INLINE readWord8 #-}
303readWord8 :: Handle -> IO ()
304readWord8 inh = S.drain $ S.unfold FH.read inh
306{-# INLINE decodeChar8 #-}
307decodeChar8 :: Handle -> IO ()
311 $ S.unfold FH.read inh
314{-# INLINE copyCodecChar8 #-}
315copyCodecChar8 :: Handle -> Handle -> IO ()
316copyCodecChar8 inh outh =
317 S.fold (FH.write outh)
320 $ S.unfold FH.read inh
323inspect $ hasNoTypeClasses 'copyCodecChar8
324inspect $ 'copyCodecChar8 `hasNoType` ''Step
325inspect $ 'copyCodecChar8 `hasNoType` ''AT.FlattenState
326inspect $ 'copyCodecChar8 `hasNoType` ''D.ConcatMapUState
329{-# INLINE decodeUtf8Lenient #-}
330decodeUtf8Lenient :: Handle -> IO ()
331decodeUtf8Lenient inh =
333 $ SS.decodeUtf8Lenient
334 $ S.unfold FH.read inh
337inspect $ hasNoTypeClasses 'decodeUtf8Lenient
338-- inspect $ 'decodeUtf8Lenient `hasNoType` ''Step
339-- inspect $ 'decodeUtf8Lenient `hasNoType` ''AT.FlattenState
340-- inspect $ 'decodeUtf8Lenient `hasNoType` ''D.ConcatMapUState
344{-# INLINE copyCodecUtf8 #-}
345copyCodecUtf8 :: Handle -> Handle -> IO ()
346copyCodecUtf8 inh outh =
347 S.fold (FH.write outh)
350 $ S.unfold FH.read inh
353inspect $ hasNoTypeClasses 'copyCodecUtf8
354-- inspect $ 'copyCodecUtf8 `hasNoType` ''Step
355-- inspect $ 'copyCodecUtf8 `hasNoType` ''AT.FlattenState
356-- inspect $ 'copyCodecUtf8 `hasNoType` ''D.ConcatMapUState
360{-# INLINE copyCodecUtf8Lenient #-}
361copyCodecUtf8Lenient :: Handle -> Handle -> IO ()
362copyCodecUtf8Lenient inh outh =
363 S.fold (FH.write outh)
365 $ SS.decodeUtf8Lenient
366 $ S.unfold FH.read inh
369inspect $ hasNoTypeClasses 'copyCodecUtf8Lenient
370-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''Step
371-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''AT.FlattenState
372-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''D.ConcatMapUState
375-- | Slice in chunks of size n and get the count of chunks.
376{-# INLINE chunksOf #-}
377chunksOf :: Int -> Handle -> IO Int
379 -- writeNUnsafe gives 2.5x boost here over writeN.
380 S.length $ S.chunksOf n (AT.writeNUnsafe n) (S.unfold FH.read inh)
383inspect $ hasNoTypeClasses 'chunksOf
384inspect $ 'chunksOf `hasNoType` ''Step
385inspect $ 'chunksOf `hasNoType` ''AT.FlattenState
386inspect $ 'chunksOf `hasNoType` ''D.ConcatMapUState
387inspect $ 'chunksOf `hasNoType` ''GroupState
390-- This is to make sure that the concatMap in FH.read, groupsOf and foldlM'
393-- | Slice in chunks of size n and get the count of chunks.
394{-# INLINE chunksOfD #-}
395chunksOfD :: Int -> Handle -> IO Int
397 D.foldlM' (\i _ -> return $ i + 1) 0
398 $ D.groupsOf n (AT.writeNUnsafe n)
399 $ D.fromStreamK (S.unfold FH.read inh)
402inspect $ hasNoTypeClasses 'chunksOf
403inspect $ 'chunksOf `hasNoType` ''Step
404inspect $ 'chunksOfD `hasNoType` ''GroupState
405inspect $ 'chunksOfD `hasNoType` ''AT.FlattenState
406inspect $ 'chunksOfD `hasNoType` ''D.ConcatMapUState
409{-# INLINE linesUnlinesCopy #-}
410linesUnlinesCopy :: Handle -> Handle -> IO ()
411linesUnlinesCopy inh outh =
412 S.fold (FH.write outh)
414 $ SS.unfoldLines IUF.fromList
415 $ S.splitOnSuffix (== '\n') FL.toList
417 $ S.unfold FH.read inh
419{-# INLINE linesUnlinesArrayWord8Copy #-}
420linesUnlinesArrayWord8Copy :: Handle -> Handle -> IO ()
421linesUnlinesArrayWord8Copy inh outh =
422 S.fold (FH.write outh)
423 $ IP.interposeSuffix 10 A.read
424 $ S.splitOnSuffix (== 10) A.write
425 $ S.unfold FH.read inh
427-- XXX splitSuffixOn requires -funfolding-use-threshold=150 for better fusion
428-- | Lines and unlines
429{-# INLINE linesUnlinesArrayCharCopy #-}
430linesUnlinesArrayCharCopy :: Handle -> Handle -> IO ()
431linesUnlinesArrayCharCopy inh outh =
432 S.fold (FH.write outh)
437 $ S.unfold FH.read inh
440inspect $ hasNoTypeClassesExcept 'linesUnlinesArrayCharCopy [''Storable]
441-- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''Step
442-- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''AT.FlattenState
443-- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''D.ConcatMapUState
446-- XXX to write this we need to be able to map decodeUtf8 on the A.read fold.
447-- For that we have to write decodeUtf8 as a Pipe.
449{-# INLINE linesUnlinesArrayUtf8Copy #-}
450linesUnlinesArrayUtf8Copy :: Handle -> Handle -> IO ()
451linesUnlinesArrayUtf8Copy inh outh =
452 S.fold (FH.write outh)
454 $ IP.intercalate (A.fromList [10]) (pipe SS.decodeUtf8P A.read)
455 $ S.splitOnSuffix (== '\n') (IFL.lmap SS.encodeUtf8 A.write)
457 $ S.unfold FH.read inh
460foreign import ccall unsafe "u_iswspace"
461 iswspace :: Int -> Int
463-- Code copied from base/Data.Char to INLINE it
464{-# INLINE isSpace #-}
465isSpace :: Char -> Bool
466-- isSpace includes non-breaking space
467-- The magic 0x377 isn't really that magical. As of 2014, all the codepoints
468-- at or below 0x377 have been assigned, so we shouldn't have to worry about
469-- any new spaces appearing below there. It would probably be best to
470-- use branchless ||, but currently the eqLit transformation will undo that,
471-- so we'll do it like this until there's a way around that.
473 | uc <= 0x377 = uc == 32 || uc - 0x9 <= 4 || uc == 0xa0
474 | otherwise = iswspace (ord c) /= 0
476 uc = fromIntegral (ord c) :: Word
480isSp = isSpace . chr . fromIntegral
482-- | Word, unwords and copy
483{-# INLINE wordsUnwordsCopyWord8 #-}
484wordsUnwordsCopyWord8 :: Handle -> Handle -> IO ()
485wordsUnwordsCopyWord8 inh outh =
486 S.fold (FH.write outh)
487 $ IP.interposeSuffix 32 IUF.fromList
488 $ S.wordsBy isSp FL.toList
489 $ S.unfold FH.read inh
492inspect $ hasNoTypeClasses 'wordsUnwordsCopyWord8
493-- inspect $ 'wordsUnwordsCopyWord8 `hasNoType` ''Step
494-- inspect $ 'wordsUnwordsCopyWord8 `hasNoType` ''D.ConcatMapUState
497-- | Word, unwords and copy
498{-# INLINE wordsUnwordsCopy #-}
499wordsUnwordsCopy :: Handle -> Handle -> IO ()
500wordsUnwordsCopy inh outh =
501 S.fold (FH.write outh)
503 $ SS.unfoldWords IUF.fromList
504 -- XXX This pipeline does not fuse with wordsBy but fuses with splitOn
505 -- with -funfolding-use-threshold=300. With wordsBy it does not fuse
506 -- even with high limits for inlining and spec-constr ghc options. With
507 -- -funfolding-use-threshold=400 it performs pretty well and there
508 -- is no evidence in the core that a join point involving Step
509 -- constructors is not getting inlined. Not being able to fuse at all in
510 -- this case could be an unknown issue, need more investigation.
511 $ S.wordsBy isSpace FL.toList
512 -- -- $ S.splitOn isSpace FL.toList
514 $ S.unfold FH.read inh
517-- inspect $ hasNoTypeClasses 'wordsUnwordsCopy
518-- inspect $ 'wordsUnwordsCopy `hasNoType` ''Step
519-- inspect $ 'wordsUnwordsCopy `hasNoType` ''AT.FlattenState
520-- inspect $ 'wordsUnwordsCopy `hasNoType` ''D.ConcatMapUState
523{-# INLINE wordsUnwordsCharArrayCopy #-}
524wordsUnwordsCharArrayCopy :: Handle -> Handle -> IO ()
525wordsUnwordsCharArrayCopy inh outh =
526 S.fold (FH.write outh)
531 $ S.unfold FH.read inh
534lf = fromIntegral (ord '\n')
536toarr :: String -> A.Array Word8
537toarr = A.fromList . map (fromIntegral . ord)
539-- | Split on line feed.
540{-# INLINE splitOn #-}
541splitOn :: Handle -> IO Int
543 (S.length $ S.splitOn (== lf) FL.drain
544 $ S.unfold FH.read inh) -- >>= print
547inspect $ hasNoTypeClasses 'splitOn
548inspect $ 'splitOn `hasNoType` ''Step
549inspect $ 'splitOn `hasNoType` ''AT.FlattenState
550inspect $ 'splitOn `hasNoType` ''D.ConcatMapUState
553-- | Split suffix on line feed.
554{-# INLINE splitOnSuffix #-}
555splitOnSuffix :: Handle -> IO Int
557 (S.length $ S.splitOnSuffix (== lf) FL.drain
558 $ S.unfold FH.read inh) -- >>= print
561inspect $ hasNoTypeClasses 'splitOnSuffix
562inspect $ 'splitOnSuffix `hasNoType` ''Step
563inspect $ 'splitOnSuffix `hasNoType` ''AT.FlattenState
564inspect $ 'splitOnSuffix `hasNoType` ''D.ConcatMapUState
568{-# INLINE wordsBy #-}
569wordsBy :: Handle -> IO Int
571 (S.length $ S.wordsBy isSp FL.drain
572 $ S.unfold FH.read inh) -- >>= print
575inspect $ hasNoTypeClasses 'wordsBy
576inspect $ 'wordsBy `hasNoType` ''Step
577inspect $ 'wordsBy `hasNoType` ''AT.FlattenState
578inspect $ 'wordsBy `hasNoType` ''D.ConcatMapUState
581-- | Split on a word8 sequence.
582{-# INLINE splitOnSeq #-}
583splitOnSeq :: String -> Handle -> IO Int
585 (S.length $ IP.splitOnSeq (toarr str) FL.drain
586 $ S.unfold FH.read inh) -- >>= print
589inspect $ hasNoTypeClasses 'splitOnSeq
590-- inspect $ 'splitOnSeq `hasNoType` ''Step
591-- inspect $ 'splitOnSeq `hasNoType` ''AT.FlattenState
592-- inspect $ 'splitOnSeq `hasNoType` ''D.ConcatMapUState
595-- | Split on a character sequence.
596{-# INLINE splitOnSeqUtf8 #-}
597splitOnSeqUtf8 :: String -> Handle -> IO Int
598splitOnSeqUtf8 str inh =
599 (S.length $ IP.splitOnSeq (A.fromList str) FL.drain
600 $ SS.decodeUtf8ArraysLenient
601 $ IFH.toStreamArrays inh) -- >>= print
603-- | Split on suffix sequence.
604{-# INLINE splitOnSuffixSeq #-}
605splitOnSuffixSeq :: String -> Handle -> IO Int
606splitOnSuffixSeq str inh =
607 (S.length $ IP.splitOnSuffixSeq (toarr str) FL.drain
608 $ S.unfold FH.read inh) -- >>= print
611inspect $ hasNoTypeClasses 'splitOnSuffixSeq
612-- inspect $ 'splitOnSuffixSeq `hasNoType` ''Step
613-- inspect $ 'splitOnSuffixSeq `hasNoType` ''AT.FlattenState
614-- 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