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
70import Control.Exception (SomeException)
71import Data.Char (ord, chr)
72import Data.Word (Word8)
73import System.IO (Handle, hClose)
74import Prelude hiding (last, length)
76import qualified Streamly.FileSystem.Handle as FH
77import qualified Streamly.Internal.FileSystem.Handle as IFH
78import qualified Streamly.Memory.Array as A
79-- import qualified Streamly.Internal.Memory.Array as IA
80import qualified Streamly.Internal.Memory.Array.Types as AT
81import qualified Streamly.Prelude as S
82import qualified Streamly.Data.Fold as FL
83-- import qualified Streamly.Internal.Data.Fold as IFL
84import qualified Streamly.Data.Unicode.Stream as SS
85import qualified Streamly.Internal.Data.Unicode.Stream as IUS
86import qualified Streamly.Internal.Memory.Unicode.Array as IUA
87import qualified Streamly.Internal.Data.Unfold as IUF
88import qualified Streamly.Internal.Prelude as IP
89import qualified Streamly.Internal.Data.Stream.StreamD as D
92import Foreign.Storable (Storable)
93import Streamly.Internal.Data.Stream.StreamD.Type (Step(..), GroupState)
97-- | Get the last byte from a file bytestream.
99last :: Handle -> IO (Maybe Word8)
100last = S.last . S.unfold FH.read
103inspect $ hasNoTypeClasses 'last
104inspect $ 'last `hasNoType` ''Step
105inspect $ 'last `hasNoType` ''AT.FlattenState
106inspect $ 'last `hasNoType` ''D.ConcatMapUState
109-- assert that flattenArrays constructors are not present
110-- | Count the number of bytes in a file.
111{-# INLINE countBytes #-}
112countBytes :: Handle -> IO Int
113countBytes = S.length . S.unfold FH.read
116inspect $ hasNoTypeClasses 'countBytes
117inspect $ 'countBytes `hasNoType` ''Step
118inspect $ 'countBytes `hasNoType` ''AT.FlattenState
119inspect $ 'countBytes `hasNoType` ''D.ConcatMapUState
122-- | Count the number of lines in a file.
123{-# INLINE countLines #-}
124countLines :: Handle -> IO Int
132inspect $ hasNoTypeClasses 'countLines
133inspect $ 'countLines `hasNoType` ''Step
134inspect $ 'countLines `hasNoType` ''AT.FlattenState
135inspect $ 'countLines `hasNoType` ''D.ConcatMapUState
138-- | Count the number of words in a file.
139{-# INLINE countWords #-}
140countWords :: Handle -> IO Int
148inspect $ hasNoTypeClasses 'countWords
149-- inspect $ 'countWords `hasNoType` ''Step
150-- inspect $ 'countWords `hasNoType` ''D.ConcatMapUState
153-- | Count the number of lines in a file.
154{-# INLINE countLinesU #-}
155countLinesU :: Handle -> IO Int
160 $ S.concatUnfold A.read (IFH.toChunks inh)
163inspect $ hasNoTypeClasses 'countLinesU
164inspect $ 'countLinesU `hasNoType` ''Step
165inspect $ 'countLinesU `hasNoType` ''D.ConcatMapUState
168-- | Sum the bytes in a file.
169{-# INLINE sumBytes #-}
170sumBytes :: Handle -> IO Word8
171sumBytes = S.sum . S.unfold FH.read
174inspect $ hasNoTypeClasses 'sumBytes
175inspect $ 'sumBytes `hasNoType` ''Step
176inspect $ 'sumBytes `hasNoType` ''AT.FlattenState
177inspect $ 'sumBytes `hasNoType` ''D.ConcatMapUState
180-- | Send the file contents to /dev/null
182cat :: Handle -> Handle -> IO ()
183cat devNull inh = S.fold (FH.write devNull) $ S.unfold FH.read inh
186inspect $ hasNoTypeClasses 'cat
187inspect $ 'cat `hasNoType` ''Step
188inspect $ 'cat `hasNoType` ''AT.FlattenState
189inspect $ 'cat `hasNoType` ''D.ConcatMapUState
192-- | Send the file contents to /dev/null
193{-# INLINE catStreamWrite #-}
194catStreamWrite :: Handle -> Handle -> IO ()
195catStreamWrite devNull inh = IFH.fromBytes devNull $ S.unfold FH.read inh
198inspect $ hasNoTypeClasses 'catStreamWrite
199inspect $ 'catStreamWrite `hasNoType` ''Step
200inspect $ 'catStreamWrite `hasNoType` ''AT.FlattenState
201inspect $ 'catStreamWrite `hasNoType` ''D.ConcatMapUState
204-- | Send the file contents to /dev/null with exception handling
205{-# INLINE catBracket #-}
206catBracket :: Handle -> Handle -> IO ()
207catBracket devNull inh =
208 let readEx = IUF.bracket return (\_ -> hClose inh) FH.read
209 in S.fold (FH.write devNull) $ S.unfold readEx inh
212inspect $ hasNoTypeClasses 'catBracket
213-- inspect $ 'catBracket `hasNoType` ''Step
214-- inspect $ 'catBracket `hasNoType` ''AT.FlattenState
215-- inspect $ 'catBracket `hasNoType` ''D.ConcatMapUState
218{-# INLINE catBracketIO #-}
219catBracketIO :: Handle -> Handle -> IO ()
220catBracketIO devNull inh =
221 let readEx = IUF.bracketIO return (\_ -> hClose inh) FH.read
222 in S.fold (FH.write devNull) $ S.unfold readEx inh
224-- | Send the file contents to /dev/null with exception handling
225{-# INLINE catBracketStream #-}
226catBracketStream :: Handle -> Handle -> IO ()
227catBracketStream devNull inh =
228 let readEx = S.bracket (return ()) (\_ -> hClose inh)
229 (\_ -> IFH.toBytes inh)
230 in IFH.fromBytes devNull $ readEx
233inspect $ hasNoTypeClasses 'catBracketStream
234-- inspect $ 'catBracketStream `hasNoType` ''Step
237{-# INLINE catBracketStreamIO #-}
238catBracketStreamIO :: Handle -> Handle -> IO ()
239catBracketStreamIO devNull inh =
240 let readEx = IP.bracketIO (return ()) (\_ -> hClose inh)
241 (\_ -> IFH.toBytes inh)
242 in IFH.fromBytes devNull $ readEx
244-- | Send the file contents to /dev/null with exception handling
245{-# INLINE catOnException #-}
246catOnException :: Handle -> Handle -> IO ()
247catOnException devNull inh =
248 let readEx = IUF.onException (\_ -> hClose inh) FH.read
249 in S.fold (FH.write devNull) $ S.unfold readEx inh
252inspect $ hasNoTypeClasses 'catOnException
253-- inspect $ 'catOnException `hasNoType` ''Step
254-- inspect $ 'catOnException `hasNoType` ''AT.FlattenState
255-- inspect $ 'catOnException `hasNoType` ''D.ConcatMapUState
258-- | Send the file contents to /dev/null with exception handling
259{-# INLINE catOnExceptionStream #-}
260catOnExceptionStream :: Handle -> Handle -> IO ()
261catOnExceptionStream devNull inh =
262 let readEx = S.onException (hClose inh) (S.unfold FH.read inh)
263 in S.fold (FH.write devNull) $ readEx
265-- | Send the file contents to /dev/null with exception handling
266{-# INLINE catFinally #-}
267catFinally :: Handle -> Handle -> IO ()
268catFinally devNull inh =
269 let readEx = IUF.finally (\_ -> hClose inh) FH.read
270 in S.fold (FH.write devNull) $ S.unfold readEx inh
273inspect $ hasNoTypeClasses 'catFinally
274-- inspect $ 'catFinally `hasNoType` ''Step
275-- inspect $ 'catFinally `hasNoType` ''AT.FlattenState
276-- inspect $ 'catFinally `hasNoType` ''D.ConcatMapUState
279{-# INLINE catFinallyIO #-}
280catFinallyIO :: Handle -> Handle -> IO ()
281catFinallyIO devNull inh =
282 let readEx = IUF.finallyIO (\_ -> hClose inh) FH.read
283 in S.fold (FH.write devNull) $ S.unfold readEx inh
285-- | Send the file contents to /dev/null with exception handling
286{-# INLINE catFinallyStream #-}
287catFinallyStream :: Handle -> Handle -> IO ()
288catFinallyStream devNull inh =
289 let readEx = S.finally (hClose inh) (S.unfold FH.read inh)
290 in S.fold (FH.write devNull) readEx
292{-# INLINE catFinallyStreamIO #-}
293catFinallyStreamIO :: Handle -> Handle -> IO ()
294catFinallyStreamIO devNull inh =
295 let readEx = IP.finallyIO (hClose inh) (S.unfold FH.read inh)
296 in S.fold (FH.write devNull) readEx
298-- | Send the file contents to /dev/null with exception handling
299{-# INLINE catHandle #-}
300catHandle :: Handle -> Handle -> IO ()
301catHandle devNull inh =
302 let handler (_e :: SomeException) = hClose inh >> return 10
303 readEx = IUF.handle (IUF.singleton handler) FH.read
304 in S.fold (FH.write devNull) $ S.unfold readEx inh
307inspect $ hasNoTypeClasses 'catHandle
308-- inspect $ 'catHandle `hasNoType` ''Step
309-- inspect $ 'catHandle `hasNoType` ''AT.FlattenState
310-- inspect $ 'catHandle `hasNoType` ''D.ConcatMapUState
313-- | Send the file contents to /dev/null with exception handling
314{-# INLINE catHandleStream #-}
315catHandleStream :: Handle -> Handle -> IO ()
316catHandleStream devNull inh =
317 let handler (_e :: SomeException) = S.yieldM (hClose inh >> return 10)
318 readEx = S.handle handler (S.unfold FH.read inh)
319 in S.fold (FH.write devNull) $ readEx
323copy :: Handle -> Handle -> IO ()
324copy inh outh = S.fold (FH.write outh) (S.unfold FH.read inh)
327inspect $ hasNoTypeClasses 'copy
328inspect $ 'copy `hasNoType` ''Step
329inspect $ 'copy `hasNoType` ''AT.FlattenState
330inspect $ 'copy `hasNoType` ''D.ConcatMapUState
333{-# INLINE readWord8 #-}
334readWord8 :: Handle -> IO ()
335readWord8 inh = S.drain $ S.unfold FH.read inh
337{-# INLINE decodeLatin1 #-}
338decodeLatin1 :: Handle -> IO ()
342 $ S.unfold FH.read inh
345{-# INLINE copyCodecChar8 #-}
346copyCodecChar8 :: Handle -> Handle -> IO ()
347copyCodecChar8 inh outh =
348 S.fold (FH.write outh)
351 $ S.unfold FH.read inh
354inspect $ hasNoTypeClasses 'copyCodecChar8
355inspect $ 'copyCodecChar8 `hasNoType` ''Step
356inspect $ 'copyCodecChar8 `hasNoType` ''AT.FlattenState
357inspect $ 'copyCodecChar8 `hasNoType` ''D.ConcatMapUState
360{-# INLINE decodeUtf8Lax #-}
361decodeUtf8Lax :: Handle -> IO ()
365 $ S.unfold FH.read inh
368inspect $ hasNoTypeClasses 'decodeUtf8Lax
369-- inspect $ 'decodeUtf8Lax `hasNoType` ''Step
370-- inspect $ 'decodeUtf8Lax `hasNoType` ''AT.FlattenState
371-- inspect $ 'decodeUtf8Lax `hasNoType` ''D.ConcatMapUState
375{-# INLINE copyCodecUtf8 #-}
376copyCodecUtf8 :: Handle -> Handle -> IO ()
377copyCodecUtf8 inh outh =
378 S.fold (FH.write outh)
381 $ S.unfold FH.read inh
384inspect $ hasNoTypeClasses 'copyCodecUtf8
385-- inspect $ 'copyCodecUtf8 `hasNoType` ''Step
386-- inspect $ 'copyCodecUtf8 `hasNoType` ''AT.FlattenState
387-- inspect $ 'copyCodecUtf8 `hasNoType` ''D.ConcatMapUState
391{-# INLINE copyCodecUtf8Lenient #-}
392copyCodecUtf8Lenient :: Handle -> Handle -> IO ()
393copyCodecUtf8Lenient inh outh =
394 S.fold (FH.write outh)
397 $ S.unfold FH.read inh
400inspect $ hasNoTypeClasses 'copyCodecUtf8Lenient
401-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''Step
402-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''AT.FlattenState
403-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''D.ConcatMapUState
406-- | Slice in chunks of size n and get the count of chunks.
407{-# INLINE chunksOf #-}
408chunksOf :: Int -> Handle -> IO Int
410 -- writeNUnsafe gives 2.5x boost here over writeN.
411 S.length $ S.chunksOf n (AT.writeNUnsafe n) (S.unfold FH.read inh)
414inspect $ hasNoTypeClasses 'chunksOf
415inspect $ 'chunksOf `hasNoType` ''Step
416inspect $ 'chunksOf `hasNoType` ''AT.FlattenState
417inspect $ 'chunksOf `hasNoType` ''D.ConcatMapUState
418inspect $ 'chunksOf `hasNoType` ''GroupState
421-- This is to make sure that the concatMap in FH.read, groupsOf and foldlM'
424-- | Slice in chunks of size n and get the count of chunks.
425{-# INLINE chunksOfD #-}
426chunksOfD :: Int -> Handle -> IO Int
428 D.foldlM' (\i _ -> return $ i + 1) 0
429 $ D.groupsOf n (AT.writeNUnsafe n)
430 $ D.fromStreamK (S.unfold FH.read inh)
433inspect $ hasNoTypeClasses 'chunksOf
434inspect $ 'chunksOf `hasNoType` ''Step
435inspect $ 'chunksOfD `hasNoType` ''GroupState
436inspect $ 'chunksOfD `hasNoType` ''AT.FlattenState
437inspect $ 'chunksOfD `hasNoType` ''D.ConcatMapUState
440{-# INLINE linesUnlinesCopy #-}
441linesUnlinesCopy :: Handle -> Handle -> IO ()
442linesUnlinesCopy inh outh =
443 S.fold (FH.write outh)
445 $ IUS.unlines IUF.fromList
446 $ S.splitOnSuffix (== '\n') FL.toList
448 $ S.unfold FH.read inh
450{-# INLINE linesUnlinesArrayWord8Copy #-}
451linesUnlinesArrayWord8Copy :: Handle -> Handle -> IO ()
452linesUnlinesArrayWord8Copy inh outh =
453 S.fold (FH.write outh)
454 $ IP.interposeSuffix 10 A.read
455 $ S.splitOnSuffix (== 10) A.write
456 $ S.unfold FH.read inh
458-- XXX splitSuffixOn requires -funfolding-use-threshold=150 for better fusion
459-- | Lines and unlines
460{-# INLINE linesUnlinesArrayCharCopy #-}
461linesUnlinesArrayCharCopy :: Handle -> Handle -> IO ()
462linesUnlinesArrayCharCopy inh outh =
463 S.fold (FH.write outh)
468 $ S.unfold FH.read inh
471inspect $ hasNoTypeClassesExcept 'linesUnlinesArrayCharCopy [''Storable]
472-- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''Step
473-- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''AT.FlattenState
474-- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''D.ConcatMapUState
477-- XXX to write this we need to be able to map decodeUtf8 on the A.read fold.
478-- For that we have to write decodeUtf8 as a Pipe.
480{-# INLINE linesUnlinesArrayUtf8Copy #-}
481linesUnlinesArrayUtf8Copy :: Handle -> Handle -> IO ()
482linesUnlinesArrayUtf8Copy inh outh =
483 S.fold (FH.write outh)
485 $ IP.intercalate (A.fromList [10]) (pipe SS.decodeUtf8P A.read)
486 $ S.splitOnSuffix (== '\n') (IFL.lmap SS.encodeUtf8 A.write)
488 $ S.unfold FH.read inh
491foreign import ccall unsafe "u_iswspace"
492 iswspace :: Int -> Int
494-- Code copied from base/Data.Char to INLINE it
495{-# INLINE isSpace #-}
496isSpace :: Char -> Bool
497-- isSpace includes non-breaking space
498-- The magic 0x377 isn't really that magical. As of 2014, all the codepoints
499-- at or below 0x377 have been assigned, so we shouldn't have to worry about
500-- any new spaces appearing below there. It would probably be best to
501-- use branchless ||, but currently the eqLit transformation will undo that,
502-- so we'll do it like this until there's a way around that.
504 | uc <= 0x377 = uc == 32 || uc - 0x9 <= 4 || uc == 0xa0
505 | otherwise = iswspace (ord c) /= 0
507 uc = fromIntegral (ord c) :: Word
511isSp = isSpace . chr . fromIntegral
513-- | Word, unwords and copy
514{-# INLINE wordsUnwordsCopyWord8 #-}
515wordsUnwordsCopyWord8 :: Handle -> Handle -> IO ()
516wordsUnwordsCopyWord8 inh outh =
517 S.fold (FH.write outh)
518 $ IP.interposeSuffix 32 IUF.fromList
519 $ S.wordsBy isSp FL.toList
520 $ S.unfold FH.read inh
523inspect $ hasNoTypeClasses 'wordsUnwordsCopyWord8
524-- inspect $ 'wordsUnwordsCopyWord8 `hasNoType` ''Step
525-- inspect $ 'wordsUnwordsCopyWord8 `hasNoType` ''D.ConcatMapUState
528-- | Word, unwords and copy
529{-# INLINE wordsUnwordsCopy #-}
530wordsUnwordsCopy :: Handle -> Handle -> IO ()
531wordsUnwordsCopy inh outh =
532 S.fold (FH.write outh)
534 $ IUS.unwords IUF.fromList
535 -- XXX This pipeline does not fuse with wordsBy but fuses with splitOn
536 -- with -funfolding-use-threshold=300. With wordsBy it does not fuse
537 -- even with high limits for inlining and spec-constr ghc options. With
538 -- -funfolding-use-threshold=400 it performs pretty well and there
539 -- is no evidence in the core that a join point involving Step
540 -- constructors is not getting inlined. Not being able to fuse at all in
541 -- this case could be an unknown issue, need more investigation.
542 $ S.wordsBy isSpace FL.toList
543 -- -- $ S.splitOn isSpace FL.toList
545 $ S.unfold FH.read inh
548-- inspect $ hasNoTypeClasses 'wordsUnwordsCopy
549-- inspect $ 'wordsUnwordsCopy `hasNoType` ''Step
550-- inspect $ 'wordsUnwordsCopy `hasNoType` ''AT.FlattenState
551-- inspect $ 'wordsUnwordsCopy `hasNoType` ''D.ConcatMapUState
554{-# INLINE wordsUnwordsCharArrayCopy #-}
555wordsUnwordsCharArrayCopy :: Handle -> Handle -> IO ()
556wordsUnwordsCharArrayCopy inh outh =
557 S.fold (FH.write outh)
562 $ S.unfold FH.read inh
565lf = fromIntegral (ord '\n')
567toarr :: String -> A.Array Word8
568toarr = A.fromList . map (fromIntegral . ord)
570-- | Split on line feed.
571{-# INLINE splitOn #-}
572splitOn :: Handle -> IO Int
574 (S.length $ S.splitOn (== lf) FL.drain
575 $ S.unfold FH.read inh) -- >>= print
578inspect $ hasNoTypeClasses 'splitOn
579inspect $ 'splitOn `hasNoType` ''Step
580inspect $ 'splitOn `hasNoType` ''AT.FlattenState
581inspect $ 'splitOn `hasNoType` ''D.ConcatMapUState
584-- | Split suffix on line feed.
585{-# INLINE splitOnSuffix #-}
586splitOnSuffix :: Handle -> IO Int
588 (S.length $ S.splitOnSuffix (== lf) FL.drain
589 $ S.unfold FH.read inh) -- >>= print
592inspect $ hasNoTypeClasses 'splitOnSuffix
593inspect $ 'splitOnSuffix `hasNoType` ''Step
594inspect $ 'splitOnSuffix `hasNoType` ''AT.FlattenState
595inspect $ 'splitOnSuffix `hasNoType` ''D.ConcatMapUState
599{-# INLINE wordsBy #-}
600wordsBy :: Handle -> IO Int
602 (S.length $ S.wordsBy isSp FL.drain
603 $ S.unfold FH.read inh) -- >>= print
606inspect $ hasNoTypeClasses 'wordsBy
607inspect $ 'wordsBy `hasNoType` ''Step
608inspect $ 'wordsBy `hasNoType` ''AT.FlattenState
609inspect $ 'wordsBy `hasNoType` ''D.ConcatMapUState
612-- | Split on a word8 sequence.
613{-# INLINE splitOnSeq #-}
614splitOnSeq :: String -> Handle -> IO Int
616 (S.length $ IP.splitOnSeq (toarr str) FL.drain
617 $ S.unfold FH.read inh) -- >>= print
620-- inspect $ hasNoTypeClasses 'splitOnSeq
621-- inspect $ 'splitOnSeq `hasNoType` ''Step
622-- inspect $ 'splitOnSeq `hasNoType` ''AT.FlattenState
623-- inspect $ 'splitOnSeq `hasNoType` ''D.ConcatMapUState
626-- | Split on a character sequence.
627{-# INLINE splitOnSeqUtf8 #-}
628splitOnSeqUtf8 :: String -> Handle -> IO Int
629splitOnSeqUtf8 str inh =
630 (S.length $ IP.splitOnSeq (A.fromList str) FL.drain
631 $ IUS.decodeUtf8ArraysLenient
632 $ IFH.toChunks inh) -- >>= print
634-- | Split on suffix sequence.
635{-# INLINE splitOnSuffixSeq #-}
636splitOnSuffixSeq :: String -> Handle -> IO Int
637splitOnSuffixSeq str inh =
638 (S.length $ IP.splitOnSuffixSeq (toarr str) FL.drain
639 $ S.unfold FH.read inh) -- >>= print
642-- inspect $ hasNoTypeClasses 'splitOnSuffixSeq
643-- inspect $ 'splitOnSuffixSeq `hasNoType` ''Step
644-- inspect $ 'splitOnSuffixSeq `hasNoType` ''AT.FlattenState
645-- 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