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
71import Control.Exception (SomeException)
72import Data.Char (ord, chr)
73import Data.Word (Word8)
74import System.IO (Handle, hClose)
75import Prelude hiding (last, length)
77import qualified Streamly.FileSystem.Handle as FH
78import qualified Streamly.Internal.FileSystem.Handle as IFH
79import qualified Streamly.Memory.Array as A
80-- import qualified Streamly.Internal.Memory.Array as IA
81import qualified Streamly.Internal.Memory.Array.Types as AT
82import qualified Streamly.Prelude as S
83import qualified Streamly.Data.Fold as FL
84-- import qualified Streamly.Internal.Data.Fold as IFL
85import qualified Streamly.Data.Unicode.Stream as SS
86import qualified Streamly.Internal.Data.Unicode.Stream as IUS
87import qualified Streamly.Internal.Memory.Unicode.Array as IUA
88import qualified Streamly.Internal.Data.Unfold as IUF
89import qualified Streamly.Internal.Prelude as IP
90import qualified Streamly.Internal.Data.Stream.StreamD as D
93import Foreign.Storable (Storable)
94import Streamly.Internal.Data.Stream.StreamD.Type (Step(..), GroupState)
98-- | Get the last byte from a file bytestream.
100last :: Handle -> IO (Maybe Word8)
101last = S.last . S.unfold FH.read
104inspect $ hasNoTypeClasses 'last
105inspect $ 'last `hasNoType` ''Step
106inspect $ 'last `hasNoType` ''AT.FlattenState
107inspect $ 'last `hasNoType` ''D.ConcatMapUState
110-- assert that flattenArrays constructors are not present
111-- | Count the number of bytes in a file.
112{-# INLINE countBytes #-}
113countBytes :: Handle -> IO Int
114countBytes = S.length . S.unfold FH.read
117inspect $ hasNoTypeClasses 'countBytes
118inspect $ 'countBytes `hasNoType` ''Step
119inspect $ 'countBytes `hasNoType` ''AT.FlattenState
120inspect $ 'countBytes `hasNoType` ''D.ConcatMapUState
123-- | Count the number of lines in a file.
124{-# INLINE countLines #-}
125countLines :: Handle -> IO Int
133inspect $ hasNoTypeClasses 'countLines
134inspect $ 'countLines `hasNoType` ''Step
135inspect $ 'countLines `hasNoType` ''AT.FlattenState
136inspect $ 'countLines `hasNoType` ''D.ConcatMapUState
139-- | Count the number of words in a file.
140{-# INLINE countWords #-}
141countWords :: Handle -> IO Int
149inspect $ hasNoTypeClasses 'countWords
150-- inspect $ 'countWords `hasNoType` ''Step
151-- inspect $ 'countWords `hasNoType` ''D.ConcatMapUState
154-- | Count the number of lines in a file.
155{-# INLINE countLinesU #-}
156countLinesU :: Handle -> IO Int
161 $ S.concatUnfold A.read (IFH.toChunks inh)
164inspect $ hasNoTypeClasses 'countLinesU
165inspect $ 'countLinesU `hasNoType` ''Step
166inspect $ 'countLinesU `hasNoType` ''D.ConcatMapUState
169-- | Sum the bytes in a file.
170{-# INLINE sumBytes #-}
171sumBytes :: Handle -> IO Word8
172sumBytes = S.sum . S.unfold FH.read
175inspect $ hasNoTypeClasses 'sumBytes
176inspect $ 'sumBytes `hasNoType` ''Step
177inspect $ 'sumBytes `hasNoType` ''AT.FlattenState
178inspect $ 'sumBytes `hasNoType` ''D.ConcatMapUState
181-- | Send the file contents to /dev/null
183cat :: Handle -> Handle -> IO ()
184cat devNull inh = S.fold (FH.write devNull) $ S.unfold FH.read inh
187inspect $ hasNoTypeClasses 'cat
188inspect $ 'cat `hasNoType` ''Step
189inspect $ 'cat `hasNoType` ''AT.FlattenState
190inspect $ 'cat `hasNoType` ''D.ConcatMapUState
193-- | Send the file contents to /dev/null
194{-# INLINE catStreamWrite #-}
195catStreamWrite :: Handle -> Handle -> IO ()
196catStreamWrite devNull inh = IFH.fromBytes devNull $ S.unfold FH.read inh
199inspect $ hasNoTypeClasses 'catStreamWrite
200inspect $ 'catStreamWrite `hasNoType` ''Step
201inspect $ 'catStreamWrite `hasNoType` ''AT.FlattenState
202inspect $ 'catStreamWrite `hasNoType` ''D.ConcatMapUState
205-- | Send the file contents to /dev/null with exception handling
206{-# INLINE catBracket #-}
207catBracket :: Handle -> Handle -> IO ()
208catBracket devNull inh =
209 let readEx = IUF.bracket return (\_ -> hClose inh) FH.read
210 in S.fold (FH.write devNull) $ S.unfold readEx inh
213inspect $ hasNoTypeClasses 'catBracket
214-- inspect $ 'catBracket `hasNoType` ''Step
215-- inspect $ 'catBracket `hasNoType` ''AT.FlattenState
216-- inspect $ 'catBracket `hasNoType` ''D.ConcatMapUState
219{-# INLINE catBracketIO #-}
220catBracketIO :: Handle -> Handle -> IO ()
221catBracketIO devNull inh =
222 let readEx = IUF.bracketIO return (\_ -> hClose inh) FH.read
223 in S.fold (FH.write devNull) $ S.unfold readEx inh
225-- | Send the file contents to /dev/null with exception handling
226{-# INLINE catBracketStream #-}
227catBracketStream :: Handle -> Handle -> IO ()
228catBracketStream devNull inh =
229 let readEx = S.bracket (return ()) (\_ -> hClose inh)
230 (\_ -> IFH.toBytes inh)
231 in IFH.fromBytes devNull $ readEx
234inspect $ hasNoTypeClasses 'catBracketStream
235-- inspect $ 'catBracketStream `hasNoType` ''Step
238{-# INLINE catBracketStreamIO #-}
239catBracketStreamIO :: Handle -> Handle -> IO ()
240catBracketStreamIO devNull inh =
241 let readEx = IP.bracketIO (return ()) (\_ -> hClose inh)
242 (\_ -> IFH.toBytes inh)
243 in IFH.fromBytes devNull $ readEx
245-- | Send the file contents to /dev/null with exception handling
246{-# INLINE catOnException #-}
247catOnException :: Handle -> Handle -> IO ()
248catOnException devNull inh =
249 let readEx = IUF.onException (\_ -> hClose inh) FH.read
250 in S.fold (FH.write devNull) $ S.unfold readEx inh
253inspect $ hasNoTypeClasses 'catOnException
254-- inspect $ 'catOnException `hasNoType` ''Step
255-- inspect $ 'catOnException `hasNoType` ''AT.FlattenState
256-- inspect $ 'catOnException `hasNoType` ''D.ConcatMapUState
259-- | Send the file contents to /dev/null with exception handling
260{-# INLINE catOnExceptionStream #-}
261catOnExceptionStream :: Handle -> Handle -> IO ()
262catOnExceptionStream devNull inh =
263 let readEx = S.onException (hClose inh) (S.unfold FH.read inh)
264 in S.fold (FH.write devNull) $ readEx
266-- | Send the file contents to /dev/null with exception handling
267{-# INLINE catFinally #-}
268catFinally :: Handle -> Handle -> IO ()
269catFinally devNull inh =
270 let readEx = IUF.finally (\_ -> hClose inh) FH.read
271 in S.fold (FH.write devNull) $ S.unfold readEx inh
274inspect $ hasNoTypeClasses 'catFinally
275-- inspect $ 'catFinally `hasNoType` ''Step
276-- inspect $ 'catFinally `hasNoType` ''AT.FlattenState
277-- inspect $ 'catFinally `hasNoType` ''D.ConcatMapUState
280{-# INLINE catFinallyIO #-}
281catFinallyIO :: Handle -> Handle -> IO ()
282catFinallyIO devNull inh =
283 let readEx = IUF.finallyIO (\_ -> hClose inh) FH.read
284 in S.fold (FH.write devNull) $ S.unfold readEx inh
286-- | Send the file contents to /dev/null with exception handling
287{-# INLINE catFinallyStream #-}
288catFinallyStream :: Handle -> Handle -> IO ()
289catFinallyStream devNull inh =
290 let readEx = S.finally (hClose inh) (S.unfold FH.read inh)
291 in S.fold (FH.write devNull) readEx
293{-# INLINE catFinallyStreamIO #-}
294catFinallyStreamIO :: Handle -> Handle -> IO ()
295catFinallyStreamIO devNull inh =
296 let readEx = IP.finallyIO (hClose inh) (S.unfold FH.read inh)
297 in S.fold (FH.write devNull) readEx
299-- | Send the file contents to /dev/null with exception handling
300{-# INLINE catHandle #-}
301catHandle :: Handle -> Handle -> IO ()
302catHandle devNull inh =
303 let handler (_e :: SomeException) = hClose inh >> return 10
304 readEx = IUF.handle (IUF.singleton handler) FH.read
305 in S.fold (FH.write devNull) $ S.unfold readEx inh
308inspect $ hasNoTypeClasses 'catHandle
309-- inspect $ 'catHandle `hasNoType` ''Step
310-- inspect $ 'catHandle `hasNoType` ''AT.FlattenState
311-- inspect $ 'catHandle `hasNoType` ''D.ConcatMapUState
314-- | Send the file contents to /dev/null with exception handling
315{-# INLINE catHandleStream #-}
316catHandleStream :: Handle -> Handle -> IO ()
317catHandleStream devNull inh =
318 let handler (_e :: SomeException) = S.yieldM (hClose inh >> return 10)
319 readEx = S.handle handler (S.unfold FH.read inh)
320 in S.fold (FH.write devNull) $ readEx
324copy :: Handle -> Handle -> IO ()
325copy inh outh = S.fold (FH.write outh) (S.unfold FH.read inh)
328inspect $ hasNoTypeClasses 'copy
329inspect $ 'copy `hasNoType` ''Step
330inspect $ 'copy `hasNoType` ''AT.FlattenState
331inspect $ 'copy `hasNoType` ''D.ConcatMapUState
334{-# INLINE readWord8 #-}
335readWord8 :: Handle -> IO ()
336readWord8 inh = S.drain $ S.unfold FH.read inh
338{-# INLINE decodeLatin1 #-}
339decodeLatin1 :: Handle -> IO ()
343 $ S.unfold FH.read inh
346{-# INLINE copyCodecChar8 #-}
347copyCodecChar8 :: Handle -> Handle -> IO ()
348copyCodecChar8 inh outh =
349 S.fold (FH.write outh)
352 $ S.unfold FH.read inh
355inspect $ hasNoTypeClasses 'copyCodecChar8
356inspect $ 'copyCodecChar8 `hasNoType` ''Step
357inspect $ 'copyCodecChar8 `hasNoType` ''AT.FlattenState
358inspect $ 'copyCodecChar8 `hasNoType` ''D.ConcatMapUState
361{-# INLINE decodeUtf8Lax #-}
362decodeUtf8Lax :: Handle -> IO ()
366 $ S.unfold FH.read inh
369inspect $ hasNoTypeClasses 'decodeUtf8Lax
370-- inspect $ 'decodeUtf8Lax `hasNoType` ''Step
371-- inspect $ 'decodeUtf8Lax `hasNoType` ''AT.FlattenState
372-- inspect $ 'decodeUtf8Lax `hasNoType` ''D.ConcatMapUState
376{-# INLINE copyCodecUtf8 #-}
377copyCodecUtf8 :: Handle -> Handle -> IO ()
378copyCodecUtf8 inh outh =
379 S.fold (FH.write outh)
382 $ S.unfold FH.read inh
385inspect $ hasNoTypeClasses 'copyCodecUtf8
386-- inspect $ 'copyCodecUtf8 `hasNoType` ''Step
387-- inspect $ 'copyCodecUtf8 `hasNoType` ''AT.FlattenState
388-- inspect $ 'copyCodecUtf8 `hasNoType` ''D.ConcatMapUState
392{-# INLINE copyCodecUtf8Lenient #-}
393copyCodecUtf8Lenient :: Handle -> Handle -> IO ()
394copyCodecUtf8Lenient inh outh =
395 S.fold (FH.write outh)
398 $ S.unfold FH.read inh
401inspect $ hasNoTypeClasses 'copyCodecUtf8Lenient
402-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''Step
403-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''AT.FlattenState
404-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''D.ConcatMapUState
407{-# INLINE chunksOfSum #-}
408chunksOfSum :: Int -> Handle -> IO Int
409chunksOfSum n inh = S.length $ S.chunksOf n FL.sum (S.unfold FH.read inh)
411-- | Slice in chunks of size n and get the count of chunks.
412{-# INLINE chunksOf #-}
413chunksOf :: Int -> Handle -> IO Int
415 -- writeNUnsafe gives 2.5x boost here over writeN.
416 S.length $ S.chunksOf n (AT.writeNUnsafe n) (S.unfold FH.read inh)
419inspect $ hasNoTypeClasses 'chunksOf
420inspect $ 'chunksOf `hasNoType` ''Step
421inspect $ 'chunksOf `hasNoType` ''AT.FlattenState
422inspect $ 'chunksOf `hasNoType` ''D.ConcatMapUState
423inspect $ 'chunksOf `hasNoType` ''GroupState
426-- This is to make sure that the concatMap in FH.read, groupsOf and foldlM'
429-- | Slice in chunks of size n and get the count of chunks.
430{-# INLINE chunksOfD #-}
431chunksOfD :: Int -> Handle -> IO Int
433 D.foldlM' (\i _ -> return $ i + 1) 0
434 $ D.groupsOf n (AT.writeNUnsafe n)
435 $ D.fromStreamK (S.unfold FH.read inh)
438inspect $ hasNoTypeClasses 'chunksOf
439inspect $ 'chunksOf `hasNoType` ''Step
440inspect $ 'chunksOfD `hasNoType` ''GroupState
441inspect $ 'chunksOfD `hasNoType` ''AT.FlattenState
442inspect $ 'chunksOfD `hasNoType` ''D.ConcatMapUState
445{-# INLINE linesUnlinesCopy #-}
446linesUnlinesCopy :: Handle -> Handle -> IO ()
447linesUnlinesCopy inh outh =
448 S.fold (FH.write outh)
450 $ IUS.unlines IUF.fromList
451 $ S.splitOnSuffix (== '\n') FL.toList
453 $ S.unfold FH.read inh
455{-# INLINE linesUnlinesArrayWord8Copy #-}
456linesUnlinesArrayWord8Copy :: Handle -> Handle -> IO ()
457linesUnlinesArrayWord8Copy inh outh =
458 S.fold (FH.write outh)
459 $ IP.interposeSuffix 10 A.read
460 $ S.splitOnSuffix (== 10) A.write
461 $ S.unfold FH.read inh
463-- XXX splitSuffixOn requires -funfolding-use-threshold=150 for better fusion
464-- | Lines and unlines
465{-# INLINE linesUnlinesArrayCharCopy #-}
466linesUnlinesArrayCharCopy :: Handle -> Handle -> IO ()
467linesUnlinesArrayCharCopy inh outh =
468 S.fold (FH.write outh)
473 $ S.unfold FH.read inh
476inspect $ hasNoTypeClassesExcept 'linesUnlinesArrayCharCopy [''Storable]
477-- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''Step
478-- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''AT.FlattenState
479-- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''D.ConcatMapUState
482-- XXX to write this we need to be able to map decodeUtf8 on the A.read fold.
483-- For that we have to write decodeUtf8 as a Pipe.
485{-# INLINE linesUnlinesArrayUtf8Copy #-}
486linesUnlinesArrayUtf8Copy :: Handle -> Handle -> IO ()
487linesUnlinesArrayUtf8Copy inh outh =
488 S.fold (FH.write outh)
490 $ IP.intercalate (A.fromList [10]) (pipe SS.decodeUtf8P A.read)
491 $ S.splitOnSuffix (== '\n') (IFL.lmap SS.encodeUtf8 A.write)
493 $ S.unfold FH.read inh
496foreign import ccall unsafe "u_iswspace"
497 iswspace :: Int -> Int
499-- Code copied from base/Data.Char to INLINE it
500{-# INLINE isSpace #-}
501isSpace :: Char -> Bool
502-- isSpace includes non-breaking space
503-- The magic 0x377 isn't really that magical. As of 2014, all the codepoints
504-- at or below 0x377 have been assigned, so we shouldn't have to worry about
505-- any new spaces appearing below there. It would probably be best to
506-- use branchless ||, but currently the eqLit transformation will undo that,
507-- so we'll do it like this until there's a way around that.
509 | uc <= 0x377 = uc == 32 || uc - 0x9 <= 4 || uc == 0xa0
510 | otherwise = iswspace (ord c) /= 0
512 uc = fromIntegral (ord c) :: Word
516isSp = isSpace . chr . fromIntegral
518-- | Word, unwords and copy
519{-# INLINE wordsUnwordsCopyWord8 #-}
520wordsUnwordsCopyWord8 :: Handle -> Handle -> IO ()
521wordsUnwordsCopyWord8 inh outh =
522 S.fold (FH.write outh)
523 $ IP.interposeSuffix 32 IUF.fromList
524 $ S.wordsBy isSp FL.toList
525 $ S.unfold FH.read inh
528inspect $ hasNoTypeClasses 'wordsUnwordsCopyWord8
529-- inspect $ 'wordsUnwordsCopyWord8 `hasNoType` ''Step
530-- inspect $ 'wordsUnwordsCopyWord8 `hasNoType` ''D.ConcatMapUState
533-- | Word, unwords and copy
534{-# INLINE wordsUnwordsCopy #-}
535wordsUnwordsCopy :: Handle -> Handle -> IO ()
536wordsUnwordsCopy inh outh =
537 S.fold (FH.write outh)
539 $ IUS.unwords IUF.fromList
540 -- XXX This pipeline does not fuse with wordsBy but fuses with splitOn
541 -- with -funfolding-use-threshold=300. With wordsBy it does not fuse
542 -- even with high limits for inlining and spec-constr ghc options. With
543 -- -funfolding-use-threshold=400 it performs pretty well and there
544 -- is no evidence in the core that a join point involving Step
545 -- constructors is not getting inlined. Not being able to fuse at all in
546 -- this case could be an unknown issue, need more investigation.
547 $ S.wordsBy isSpace FL.toList
548 -- -- $ S.splitOn isSpace FL.toList
550 $ S.unfold FH.read inh
553-- inspect $ hasNoTypeClasses 'wordsUnwordsCopy
554-- inspect $ 'wordsUnwordsCopy `hasNoType` ''Step
555-- inspect $ 'wordsUnwordsCopy `hasNoType` ''AT.FlattenState
556-- inspect $ 'wordsUnwordsCopy `hasNoType` ''D.ConcatMapUState
559{-# INLINE wordsUnwordsCharArrayCopy #-}
560wordsUnwordsCharArrayCopy :: Handle -> Handle -> IO ()
561wordsUnwordsCharArrayCopy inh outh =
562 S.fold (FH.write outh)
567 $ S.unfold FH.read inh
570lf = fromIntegral (ord '\n')
572toarr :: String -> A.Array Word8
573toarr = A.fromList . map (fromIntegral . ord)
575-- | Split on line feed.
576{-# INLINE splitOn #-}
577splitOn :: Handle -> IO Int
579 (S.length $ S.splitOn (== lf) FL.drain
580 $ S.unfold FH.read inh) -- >>= print
583inspect $ hasNoTypeClasses 'splitOn
584inspect $ 'splitOn `hasNoType` ''Step
585inspect $ 'splitOn `hasNoType` ''AT.FlattenState
586inspect $ 'splitOn `hasNoType` ''D.ConcatMapUState
589-- | Split suffix on line feed.
590{-# INLINE splitOnSuffix #-}
591splitOnSuffix :: Handle -> IO Int
593 (S.length $ S.splitOnSuffix (== lf) FL.drain
594 $ S.unfold FH.read inh) -- >>= print
597inspect $ hasNoTypeClasses 'splitOnSuffix
598inspect $ 'splitOnSuffix `hasNoType` ''Step
599inspect $ 'splitOnSuffix `hasNoType` ''AT.FlattenState
600inspect $ 'splitOnSuffix `hasNoType` ''D.ConcatMapUState
604{-# INLINE wordsBy #-}
605wordsBy :: Handle -> IO Int
607 (S.length $ S.wordsBy isSp FL.drain
608 $ S.unfold FH.read inh) -- >>= print
611inspect $ hasNoTypeClasses 'wordsBy
612inspect $ 'wordsBy `hasNoType` ''Step
613inspect $ 'wordsBy `hasNoType` ''AT.FlattenState
614inspect $ 'wordsBy `hasNoType` ''D.ConcatMapUState
617-- | Split on a word8 sequence.
618{-# INLINE splitOnSeq #-}
619splitOnSeq :: String -> Handle -> IO Int
621 (S.length $ IP.splitOnSeq (toarr str) FL.drain
622 $ S.unfold FH.read inh) -- >>= print
625-- inspect $ hasNoTypeClasses 'splitOnSeq
626-- inspect $ 'splitOnSeq `hasNoType` ''Step
627-- inspect $ 'splitOnSeq `hasNoType` ''AT.FlattenState
628-- inspect $ 'splitOnSeq `hasNoType` ''D.ConcatMapUState
631-- | Split on a character sequence.
632{-# INLINE splitOnSeqUtf8 #-}
633splitOnSeqUtf8 :: String -> Handle -> IO Int
634splitOnSeqUtf8 str inh =
635 (S.length $ IP.splitOnSeq (A.fromList str) FL.drain
636 $ IUS.decodeUtf8ArraysLenient
637 $ IFH.toChunks inh) -- >>= print
639-- | Split on suffix sequence.
640{-# INLINE splitOnSuffixSeq #-}
641splitOnSuffixSeq :: String -> Handle -> IO Int
642splitOnSuffixSeq str inh =
643 (S.length $ IP.splitOnSuffixSeq (toarr str) FL.drain
644 $ S.unfold FH.read inh) -- >>= print
647-- inspect $ hasNoTypeClasses 'splitOnSuffixSeq
648-- inspect $ 'splitOnSuffixSeq `hasNoType` ''Step
649-- inspect $ 'splitOnSuffixSeq `hasNoType` ''AT.FlattenState
650-- 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