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.Unicode.Stream as SS
81import qualified Streamly.Internal.Data.Unicode.Stream as IUS
82import qualified Streamly.Internal.Data.Unfold as IUF
83import qualified Streamly.Internal.Prelude as IP
84import qualified Streamly.Streams.StreamD as D
87import Foreign.Storable (Storable)
88import Streamly.Streams.StreamD.Type (Step(..), GroupState)
92-- | Get the last byte from a file bytestream.
94last :: Handle -> IO (Maybe Word8)
95last = S.last . S.unfold FH.read
98inspect $ hasNoTypeClasses 'last
99inspect $ 'last `hasNoType` ''Step
100inspect $ 'last `hasNoType` ''AT.FlattenState
101inspect $ 'last `hasNoType` ''D.ConcatMapUState
104-- assert that flattenArrays constructors are not present
105-- | Count the number of bytes in a file.
106{-# INLINE countBytes #-}
107countBytes :: Handle -> IO Int
108countBytes = S.length . S.unfold FH.read
111inspect $ hasNoTypeClasses 'countBytes
112inspect $ 'countBytes `hasNoType` ''Step
113inspect $ 'countBytes `hasNoType` ''AT.FlattenState
114inspect $ 'countBytes `hasNoType` ''D.ConcatMapUState
117-- | Count the number of lines in a file.
118{-# INLINE countLines #-}
119countLines :: Handle -> IO Int
122 . SS.foldLines FL.drain
127inspect $ hasNoTypeClasses 'countLines
128inspect $ 'countLines `hasNoType` ''Step
129inspect $ 'countLines `hasNoType` ''AT.FlattenState
130inspect $ 'countLines `hasNoType` ''D.ConcatMapUState
133-- | Count the number of words in a file.
134{-# INLINE countWords #-}
135countWords :: Handle -> IO Int
138 . SS.foldWords FL.drain
143inspect $ hasNoTypeClasses 'countWords
144-- inspect $ 'countWords `hasNoType` ''Step
145-- inspect $ 'countWords `hasNoType` ''D.ConcatMapUState
148-- | Count the number of lines in a file.
149{-# INLINE countLinesU #-}
150countLinesU :: Handle -> IO Int
153 $ SS.foldLines FL.drain
155 $ S.concatUnfold A.read (IFH.toStreamArrays inh)
158inspect $ hasNoTypeClasses 'countLinesU
159inspect $ 'countLinesU `hasNoType` ''Step
160inspect $ 'countLinesU `hasNoType` ''D.ConcatMapUState
163-- | Sum the bytes in a file.
164{-# INLINE sumBytes #-}
165sumBytes :: Handle -> IO Word8
166sumBytes = S.sum . S.unfold FH.read
169inspect $ hasNoTypeClasses 'sumBytes
170inspect $ 'sumBytes `hasNoType` ''Step
171inspect $ 'sumBytes `hasNoType` ''AT.FlattenState
172inspect $ 'sumBytes `hasNoType` ''D.ConcatMapUState
175-- | Send the file contents to /dev/null
177cat :: Handle -> Handle -> IO ()
178cat devNull inh = S.fold (FH.write devNull) $ S.unfold FH.read inh
181inspect $ hasNoTypeClasses 'cat
182inspect $ 'cat `hasNoType` ''Step
183inspect $ 'cat `hasNoType` ''AT.FlattenState
184inspect $ 'cat `hasNoType` ''D.ConcatMapUState
187-- | Send the file contents to /dev/null
188{-# INLINE catStreamWrite #-}
189catStreamWrite :: Handle -> Handle -> IO ()
190catStreamWrite devNull inh = IFH.fromStream devNull $ S.unfold FH.read inh
193inspect $ hasNoTypeClasses 'catStreamWrite
194inspect $ 'catStreamWrite `hasNoType` ''Step
195inspect $ 'catStreamWrite `hasNoType` ''AT.FlattenState
196inspect $ 'catStreamWrite `hasNoType` ''D.ConcatMapUState
199-- | Send the file contents to /dev/null with exception handling
200{-# INLINE catBracket #-}
201catBracket :: Handle -> Handle -> IO ()
202catBracket devNull inh =
203 let readEx = IUF.bracket return (\_ -> hClose inh) FH.read
204 in S.fold (FH.write devNull) $ S.unfold readEx inh
207inspect $ hasNoTypeClasses 'catBracket
208-- inspect $ 'catBracket `hasNoType` ''Step
209-- inspect $ 'catBracket `hasNoType` ''AT.FlattenState
210-- inspect $ 'catBracket `hasNoType` ''D.ConcatMapUState
213-- | Send the file contents to /dev/null with exception handling
214{-# INLINE catBracketStream #-}
215catBracketStream :: Handle -> Handle -> IO ()
216catBracketStream devNull inh =
217 let readEx = S.bracket (return ()) (\_ -> hClose inh)
218 (\_ -> IFH.toStream inh)
219 in IFH.fromStream devNull $ readEx
222inspect $ hasNoTypeClasses 'catBracketStream
223-- inspect $ 'catBracketStream `hasNoType` ''Step
226-- | Send the file contents to /dev/null with exception handling
227{-# INLINE catOnException #-}
228catOnException :: Handle -> Handle -> IO ()
229catOnException devNull inh =
230 let readEx = IUF.onException (\_ -> hClose inh) FH.read
231 in S.fold (FH.write devNull) $ S.unfold readEx inh
234inspect $ hasNoTypeClasses 'catOnException
235-- inspect $ 'catOnException `hasNoType` ''Step
236-- inspect $ 'catOnException `hasNoType` ''AT.FlattenState
237-- inspect $ 'catOnException `hasNoType` ''D.ConcatMapUState
240-- | Send the file contents to /dev/null with exception handling
241{-# INLINE catOnExceptionStream #-}
242catOnExceptionStream :: Handle -> Handle -> IO ()
243catOnExceptionStream devNull inh =
244 let readEx = S.onException (hClose inh) (S.unfold FH.read inh)
245 in S.fold (FH.write devNull) $ readEx
247-- | Send the file contents to /dev/null with exception handling
248{-# INLINE catFinally #-}
249catFinally :: Handle -> Handle -> IO ()
250catFinally devNull inh =
251 let readEx = IUF.finally (\_ -> hClose inh) FH.read
252 in S.fold (FH.write devNull) $ S.unfold readEx inh
255inspect $ hasNoTypeClasses 'catFinally
256-- inspect $ 'catFinally `hasNoType` ''Step
257-- inspect $ 'catFinally `hasNoType` ''AT.FlattenState
258-- inspect $ 'catFinally `hasNoType` ''D.ConcatMapUState
261-- | Send the file contents to /dev/null with exception handling
262{-# INLINE catFinallyStream #-}
263catFinallyStream :: Handle -> Handle -> IO ()
264catFinallyStream devNull inh =
265 let readEx = S.finally (hClose inh) (S.unfold FH.read inh)
266 in S.fold (FH.write devNull) readEx
268-- | Send the file contents to /dev/null with exception handling
269{-# INLINE catHandle #-}
270catHandle :: Handle -> Handle -> IO ()
271catHandle devNull inh =
272 let handler (_e :: SomeException) = hClose inh >> return 10
273 readEx = IUF.handle (IUF.singleton handler) FH.read
274 in S.fold (FH.write devNull) $ S.unfold readEx inh
277inspect $ hasNoTypeClasses 'catHandle
278-- inspect $ 'catHandle `hasNoType` ''Step
279-- inspect $ 'catHandle `hasNoType` ''AT.FlattenState
280-- inspect $ 'catHandle `hasNoType` ''D.ConcatMapUState
283-- | Send the file contents to /dev/null with exception handling
284{-# INLINE catHandleStream #-}
285catHandleStream :: Handle -> Handle -> IO ()
286catHandleStream devNull inh =
287 let handler (_e :: SomeException) = S.yieldM (hClose inh >> return 10)
288 readEx = S.handle handler (S.unfold FH.read inh)
289 in S.fold (FH.write devNull) $ readEx
293copy :: Handle -> Handle -> IO ()
294copy inh outh = S.fold (FH.write outh) (S.unfold FH.read inh)
297inspect $ hasNoTypeClasses 'copy
298inspect $ 'copy `hasNoType` ''Step
299inspect $ 'copy `hasNoType` ''AT.FlattenState
300inspect $ 'copy `hasNoType` ''D.ConcatMapUState
303{-# INLINE readWord8 #-}
304readWord8 :: Handle -> IO ()
305readWord8 inh = S.drain $ S.unfold FH.read inh
307{-# INLINE decodeChar8 #-}
308decodeChar8 :: Handle -> IO ()
312 $ S.unfold FH.read inh
315{-# INLINE copyCodecChar8 #-}
316copyCodecChar8 :: Handle -> Handle -> IO ()
317copyCodecChar8 inh outh =
318 S.fold (FH.write outh)
321 $ S.unfold FH.read inh
324inspect $ hasNoTypeClasses 'copyCodecChar8
325inspect $ 'copyCodecChar8 `hasNoType` ''Step
326inspect $ 'copyCodecChar8 `hasNoType` ''AT.FlattenState
327inspect $ 'copyCodecChar8 `hasNoType` ''D.ConcatMapUState
330{-# INLINE decodeUtf8Lenient #-}
331decodeUtf8Lenient :: Handle -> IO ()
332decodeUtf8Lenient inh =
334 $ SS.decodeUtf8Lenient
335 $ S.unfold FH.read inh
338inspect $ hasNoTypeClasses 'decodeUtf8Lenient
339-- inspect $ 'decodeUtf8Lenient `hasNoType` ''Step
340-- inspect $ 'decodeUtf8Lenient `hasNoType` ''AT.FlattenState
341-- inspect $ 'decodeUtf8Lenient `hasNoType` ''D.ConcatMapUState
345{-# INLINE copyCodecUtf8 #-}
346copyCodecUtf8 :: Handle -> Handle -> IO ()
347copyCodecUtf8 inh outh =
348 S.fold (FH.write outh)
351 $ S.unfold FH.read inh
354inspect $ hasNoTypeClasses 'copyCodecUtf8
355-- inspect $ 'copyCodecUtf8 `hasNoType` ''Step
356-- inspect $ 'copyCodecUtf8 `hasNoType` ''AT.FlattenState
357-- inspect $ 'copyCodecUtf8 `hasNoType` ''D.ConcatMapUState
361{-# INLINE copyCodecUtf8Lenient #-}
362copyCodecUtf8Lenient :: Handle -> Handle -> IO ()
363copyCodecUtf8Lenient inh outh =
364 S.fold (FH.write outh)
366 $ SS.decodeUtf8Lenient
367 $ S.unfold FH.read inh
370inspect $ hasNoTypeClasses 'copyCodecUtf8Lenient
371-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''Step
372-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''AT.FlattenState
373-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''D.ConcatMapUState
376-- | Slice in chunks of size n and get the count of chunks.
377{-# INLINE chunksOf #-}
378chunksOf :: Int -> Handle -> IO Int
380 -- writeNUnsafe gives 2.5x boost here over writeN.
381 S.length $ S.chunksOf n (AT.writeNUnsafe n) (S.unfold FH.read inh)
384inspect $ hasNoTypeClasses 'chunksOf
385inspect $ 'chunksOf `hasNoType` ''Step
386inspect $ 'chunksOf `hasNoType` ''AT.FlattenState
387inspect $ 'chunksOf `hasNoType` ''D.ConcatMapUState
388inspect $ 'chunksOf `hasNoType` ''GroupState
391-- This is to make sure that the concatMap in FH.read, groupsOf and foldlM'
394-- | Slice in chunks of size n and get the count of chunks.
395{-# INLINE chunksOfD #-}
396chunksOfD :: Int -> Handle -> IO Int
398 D.foldlM' (\i _ -> return $ i + 1) 0
399 $ D.groupsOf n (AT.writeNUnsafe n)
400 $ D.fromStreamK (S.unfold FH.read inh)
403inspect $ hasNoTypeClasses 'chunksOf
404inspect $ 'chunksOf `hasNoType` ''Step
405inspect $ 'chunksOfD `hasNoType` ''GroupState
406inspect $ 'chunksOfD `hasNoType` ''AT.FlattenState
407inspect $ 'chunksOfD `hasNoType` ''D.ConcatMapUState
410{-# INLINE linesUnlinesCopy #-}
411linesUnlinesCopy :: Handle -> Handle -> IO ()
412linesUnlinesCopy inh outh =
413 S.fold (FH.write outh)
415 $ SS.unfoldLines IUF.fromList
416 $ S.splitOnSuffix (== '\n') FL.toList
418 $ S.unfold FH.read inh
420{-# INLINE linesUnlinesArrayWord8Copy #-}
421linesUnlinesArrayWord8Copy :: Handle -> Handle -> IO ()
422linesUnlinesArrayWord8Copy inh outh =
423 S.fold (FH.write outh)
424 $ IP.interposeSuffix 10 A.read
425 $ S.splitOnSuffix (== 10) A.write
426 $ S.unfold FH.read inh
428-- XXX splitSuffixOn requires -funfolding-use-threshold=150 for better fusion
429-- | Lines and unlines
430{-# INLINE linesUnlinesArrayCharCopy #-}
431linesUnlinesArrayCharCopy :: Handle -> Handle -> IO ()
432linesUnlinesArrayCharCopy inh outh =
433 S.fold (FH.write outh)
438 $ S.unfold FH.read inh
441inspect $ hasNoTypeClassesExcept 'linesUnlinesArrayCharCopy [''Storable]
442-- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''Step
443-- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''AT.FlattenState
444-- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''D.ConcatMapUState
447-- XXX to write this we need to be able to map decodeUtf8 on the A.read fold.
448-- For that we have to write decodeUtf8 as a Pipe.
450{-# INLINE linesUnlinesArrayUtf8Copy #-}
451linesUnlinesArrayUtf8Copy :: Handle -> Handle -> IO ()
452linesUnlinesArrayUtf8Copy inh outh =
453 S.fold (FH.write outh)
455 $ IP.intercalate (A.fromList [10]) (pipe SS.decodeUtf8P A.read)
456 $ S.splitOnSuffix (== '\n') (IFL.lmap SS.encodeUtf8 A.write)
458 $ S.unfold FH.read inh
461foreign import ccall unsafe "u_iswspace"
462 iswspace :: Int -> Int
464-- Code copied from base/Data.Char to INLINE it
465{-# INLINE isSpace #-}
466isSpace :: Char -> Bool
467-- isSpace includes non-breaking space
468-- The magic 0x377 isn't really that magical. As of 2014, all the codepoints
469-- at or below 0x377 have been assigned, so we shouldn't have to worry about
470-- any new spaces appearing below there. It would probably be best to
471-- use branchless ||, but currently the eqLit transformation will undo that,
472-- so we'll do it like this until there's a way around that.
474 | uc <= 0x377 = uc == 32 || uc - 0x9 <= 4 || uc == 0xa0
475 | otherwise = iswspace (ord c) /= 0
477 uc = fromIntegral (ord c) :: Word
481isSp = isSpace . chr . fromIntegral
483-- | Word, unwords and copy
484{-# INLINE wordsUnwordsCopyWord8 #-}
485wordsUnwordsCopyWord8 :: Handle -> Handle -> IO ()
486wordsUnwordsCopyWord8 inh outh =
487 S.fold (FH.write outh)
488 $ IP.interposeSuffix 32 IUF.fromList
489 $ S.wordsBy isSp FL.toList
490 $ S.unfold FH.read inh
493inspect $ hasNoTypeClasses 'wordsUnwordsCopyWord8
494-- inspect $ 'wordsUnwordsCopyWord8 `hasNoType` ''Step
495-- inspect $ 'wordsUnwordsCopyWord8 `hasNoType` ''D.ConcatMapUState
498-- | Word, unwords and copy
499{-# INLINE wordsUnwordsCopy #-}
500wordsUnwordsCopy :: Handle -> Handle -> IO ()
501wordsUnwordsCopy inh outh =
502 S.fold (FH.write outh)
504 $ SS.unfoldWords IUF.fromList
505 -- XXX This pipeline does not fuse with wordsBy but fuses with splitOn
506 -- with -funfolding-use-threshold=300. With wordsBy it does not fuse
507 -- even with high limits for inlining and spec-constr ghc options. With
508 -- -funfolding-use-threshold=400 it performs pretty well and there
509 -- is no evidence in the core that a join point involving Step
510 -- constructors is not getting inlined. Not being able to fuse at all in
511 -- this case could be an unknown issue, need more investigation.
512 $ S.wordsBy isSpace FL.toList
513 -- -- $ S.splitOn isSpace FL.toList
515 $ S.unfold FH.read inh
518-- inspect $ hasNoTypeClasses 'wordsUnwordsCopy
519-- inspect $ 'wordsUnwordsCopy `hasNoType` ''Step
520-- inspect $ 'wordsUnwordsCopy `hasNoType` ''AT.FlattenState
521-- inspect $ 'wordsUnwordsCopy `hasNoType` ''D.ConcatMapUState
524{-# INLINE wordsUnwordsCharArrayCopy #-}
525wordsUnwordsCharArrayCopy :: Handle -> Handle -> IO ()
526wordsUnwordsCharArrayCopy inh outh =
527 S.fold (FH.write outh)
532 $ S.unfold FH.read inh
535lf = fromIntegral (ord '\n')
537toarr :: String -> A.Array Word8
538toarr = A.fromList . map (fromIntegral . ord)
540-- | Split on line feed.
541{-# INLINE splitOn #-}
542splitOn :: Handle -> IO Int
544 (S.length $ S.splitOn (== lf) FL.drain
545 $ S.unfold FH.read inh) -- >>= print
548inspect $ hasNoTypeClasses 'splitOn
549inspect $ 'splitOn `hasNoType` ''Step
550inspect $ 'splitOn `hasNoType` ''AT.FlattenState
551inspect $ 'splitOn `hasNoType` ''D.ConcatMapUState
554-- | Split suffix on line feed.
555{-# INLINE splitOnSuffix #-}
556splitOnSuffix :: Handle -> IO Int
558 (S.length $ S.splitOnSuffix (== lf) FL.drain
559 $ S.unfold FH.read inh) -- >>= print
562inspect $ hasNoTypeClasses 'splitOnSuffix
563inspect $ 'splitOnSuffix `hasNoType` ''Step
564inspect $ 'splitOnSuffix `hasNoType` ''AT.FlattenState
565inspect $ 'splitOnSuffix `hasNoType` ''D.ConcatMapUState
569{-# INLINE wordsBy #-}
570wordsBy :: Handle -> IO Int
572 (S.length $ S.wordsBy isSp FL.drain
573 $ S.unfold FH.read inh) -- >>= print
576inspect $ hasNoTypeClasses 'wordsBy
577inspect $ 'wordsBy `hasNoType` ''Step
578inspect $ 'wordsBy `hasNoType` ''AT.FlattenState
579inspect $ 'wordsBy `hasNoType` ''D.ConcatMapUState
582-- | Split on a word8 sequence.
583{-# INLINE splitOnSeq #-}
584splitOnSeq :: String -> Handle -> IO Int
586 (S.length $ IP.splitOnSeq (toarr str) FL.drain
587 $ S.unfold FH.read inh) -- >>= print
590inspect $ hasNoTypeClasses 'splitOnSeq
591-- inspect $ 'splitOnSeq `hasNoType` ''Step
592-- inspect $ 'splitOnSeq `hasNoType` ''AT.FlattenState
593-- inspect $ 'splitOnSeq `hasNoType` ''D.ConcatMapUState
596-- | Split on a character sequence.
597{-# INLINE splitOnSeqUtf8 #-}
598splitOnSeqUtf8 :: String -> Handle -> IO Int
599splitOnSeqUtf8 str inh =
600 (S.length $ IP.splitOnSeq (A.fromList str) FL.drain
601 $ IUS.decodeUtf8ArraysLenient
602 $ IFH.toStreamArrays inh) -- >>= print
604-- | Split on suffix sequence.
605{-# INLINE splitOnSuffixSeq #-}
606splitOnSuffixSeq :: String -> Handle -> IO Int
607splitOnSuffixSeq str inh =
608 (S.length $ IP.splitOnSuffixSeq (toarr str) FL.drain
609 $ S.unfold FH.read inh) -- >>= print
612inspect $ hasNoTypeClasses 'splitOnSuffixSeq
613-- inspect $ 'splitOnSuffixSeq `hasNoType` ''Step
614-- inspect $ 'splitOnSuffixSeq `hasNoType` ''AT.FlattenState
615-- 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