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 , wordsUnwordsCopyWord8
50 , copyCodecUtf8Lenient
62import Control.Exception (SomeException)
63import Data.Char (ord, chr)
64import Data.Word (Word8)
65import System.IO (Handle, hClose)
66import Prelude hiding (last, length)
68import qualified Streamly.FileSystem.Handle as FH
69import qualified Streamly.Internal.FileSystem.Handle as IFH
70import qualified Streamly.Memory.Array as A
71import qualified Streamly.Internal.Memory.Array.Types as AT
72import qualified Streamly.Prelude as S
73import qualified Streamly.Data.Fold as FL
74import qualified Streamly.Data.String as SS
75import qualified Streamly.Internal.Data.Unfold as IUF
76import qualified Streamly.Internal.Prelude as IP
77import qualified Streamly.Streams.StreamD as D
80import Foreign.Storable (Storable)
81import Streamly.Streams.StreamD.Type (Step(..), GroupState)
85-- | Get the last byte from a file bytestream.
87last :: Handle -> IO (Maybe Word8)
88last = S.last . S.unfold FH.read
91inspect $ hasNoTypeClasses 'last
92inspect $ 'last `hasNoType` ''Step
93inspect $ 'last `hasNoType` ''AT.FlattenState
94inspect $ 'last `hasNoType` ''D.ConcatMapUState
97-- assert that flattenArrays constructors are not present
98-- | Count the number of bytes in a file.
99{-# INLINE countBytes #-}
100countBytes :: Handle -> IO Int
101countBytes = S.length . S.unfold FH.read
104inspect $ hasNoTypeClasses 'countBytes
105inspect $ 'countBytes `hasNoType` ''Step
106inspect $ 'countBytes `hasNoType` ''AT.FlattenState
107inspect $ 'countBytes `hasNoType` ''D.ConcatMapUState
110-- | Count the number of lines in a file.
111{-# INLINE countLines #-}
112countLines :: Handle -> IO Int
115 . SS.foldLines FL.drain
120inspect $ hasNoTypeClasses 'countLines
121inspect $ 'countLines `hasNoType` ''Step
122inspect $ 'countLines `hasNoType` ''AT.FlattenState
123inspect $ 'countLines `hasNoType` ''D.ConcatMapUState
126-- | Count the number of words in a file.
127{-# INLINE countWords #-}
128countWords :: Handle -> IO Int
131 . SS.foldWords FL.drain
136inspect $ hasNoTypeClasses 'countWords
137-- inspect $ 'countWords `hasNoType` ''Step
138-- inspect $ 'countWords `hasNoType` ''D.ConcatMapUState
141-- | Count the number of lines in a file.
142{-# INLINE countLinesU #-}
143countLinesU :: Handle -> IO Int
146 $ SS.foldLines FL.drain
148 $ S.concatUnfold A.read (IFH.toStreamArrays inh)
151inspect $ hasNoTypeClasses 'countLinesU
152inspect $ 'countLinesU `hasNoType` ''Step
153inspect $ 'countLinesU `hasNoType` ''D.ConcatMapUState
156-- | Sum the bytes in a file.
157{-# INLINE sumBytes #-}
158sumBytes :: Handle -> IO Word8
159sumBytes = S.sum . S.unfold FH.read
162inspect $ hasNoTypeClasses 'sumBytes
163inspect $ 'sumBytes `hasNoType` ''Step
164inspect $ 'sumBytes `hasNoType` ''AT.FlattenState
165inspect $ 'sumBytes `hasNoType` ''D.ConcatMapUState
168-- | Send the file contents to /dev/null
170cat :: Handle -> Handle -> IO ()
171cat devNull inh = S.fold (FH.write devNull) $ S.unfold FH.read inh
174inspect $ hasNoTypeClasses 'cat
175inspect $ 'cat `hasNoType` ''Step
176inspect $ 'cat `hasNoType` ''AT.FlattenState
177inspect $ 'cat `hasNoType` ''D.ConcatMapUState
180-- | Send the file contents to /dev/null
181{-# INLINE catStreamWrite #-}
182catStreamWrite :: Handle -> Handle -> IO ()
183catStreamWrite devNull inh = IFH.fromStream devNull $ S.unfold FH.read inh
186inspect $ hasNoTypeClasses 'catStreamWrite
187inspect $ 'catStreamWrite `hasNoType` ''Step
188inspect $ 'catStreamWrite `hasNoType` ''AT.FlattenState
189inspect $ 'catStreamWrite `hasNoType` ''D.ConcatMapUState
192-- | Send the file contents to /dev/null with exception handling
193{-# INLINE catBracket #-}
194catBracket :: Handle -> Handle -> IO ()
195catBracket devNull inh =
196 let readEx = IUF.bracket return (\_ -> hClose inh) FH.read
197 in S.fold (FH.write devNull) $ S.unfold readEx inh
200inspect $ hasNoTypeClasses 'catBracket
201-- inspect $ 'catBracket `hasNoType` ''Step
202-- inspect $ 'catBracket `hasNoType` ''AT.FlattenState
203-- inspect $ 'catBracket `hasNoType` ''D.ConcatMapUState
206-- | Send the file contents to /dev/null with exception handling
207{-# INLINE catBracketStream #-}
208catBracketStream :: Handle -> Handle -> IO ()
209catBracketStream devNull inh =
210 let readEx = S.bracket (return ()) (\_ -> hClose inh)
211 (\_ -> IFH.toStream inh)
212 in IFH.fromStream devNull $ readEx
215inspect $ hasNoTypeClasses 'catBracketStream
216-- inspect $ 'catBracketStream `hasNoType` ''Step
219-- | Send the file contents to /dev/null with exception handling
220{-# INLINE catOnException #-}
221catOnException :: Handle -> Handle -> IO ()
222catOnException devNull inh =
223 let readEx = IUF.onException (\_ -> hClose inh) FH.read
224 in S.fold (FH.write devNull) $ S.unfold readEx inh
227inspect $ hasNoTypeClasses 'catOnException
228-- inspect $ 'catOnException `hasNoType` ''Step
229-- inspect $ 'catOnException `hasNoType` ''AT.FlattenState
230-- inspect $ 'catOnException `hasNoType` ''D.ConcatMapUState
233-- | Send the file contents to /dev/null with exception handling
234{-# INLINE catOnExceptionStream #-}
235catOnExceptionStream :: Handle -> Handle -> IO ()
236catOnExceptionStream devNull inh =
237 let readEx = S.onException (hClose inh) (S.unfold FH.read inh)
238 in S.fold (FH.write devNull) $ readEx
240-- | Send the file contents to /dev/null with exception handling
241{-# INLINE catFinally #-}
242catFinally :: Handle -> Handle -> IO ()
243catFinally devNull inh =
244 let readEx = IUF.finally (\_ -> hClose inh) FH.read
245 in S.fold (FH.write devNull) $ S.unfold readEx inh
248inspect $ hasNoTypeClasses 'catFinally
249-- inspect $ 'catFinally `hasNoType` ''Step
250-- inspect $ 'catFinally `hasNoType` ''AT.FlattenState
251-- inspect $ 'catFinally `hasNoType` ''D.ConcatMapUState
254-- | Send the file contents to /dev/null with exception handling
255{-# INLINE catFinallyStream #-}
256catFinallyStream :: Handle -> Handle -> IO ()
257catFinallyStream devNull inh =
258 let readEx = S.finally (hClose inh) (S.unfold FH.read inh)
259 in S.fold (FH.write devNull) readEx
261-- | Send the file contents to /dev/null with exception handling
262{-# INLINE catHandle #-}
263catHandle :: Handle -> Handle -> IO ()
264catHandle devNull inh =
265 let handler (_e :: SomeException) = hClose inh >> return 10
266 readEx = IUF.handle (IUF.singleton handler) FH.read
267 in S.fold (FH.write devNull) $ S.unfold readEx inh
270inspect $ hasNoTypeClasses 'catHandle
271-- inspect $ 'catHandle `hasNoType` ''Step
272-- inspect $ 'catHandle `hasNoType` ''AT.FlattenState
273-- inspect $ 'catHandle `hasNoType` ''D.ConcatMapUState
276-- | Send the file contents to /dev/null with exception handling
277{-# INLINE catHandleStream #-}
278catHandleStream :: Handle -> Handle -> IO ()
279catHandleStream devNull inh =
280 let handler (_e :: SomeException) = S.yieldM (hClose inh >> return 10)
281 readEx = S.handle handler (S.unfold FH.read inh)
282 in S.fold (FH.write devNull) $ readEx
286copy :: Handle -> Handle -> IO ()
287copy inh outh = S.fold (FH.write outh) (S.unfold FH.read inh)
290inspect $ hasNoTypeClasses 'copy
291inspect $ 'copy `hasNoType` ''Step
292inspect $ 'copy `hasNoType` ''AT.FlattenState
293inspect $ 'copy `hasNoType` ''D.ConcatMapUState
296{-# INLINE readWord8 #-}
297readWord8 :: Handle -> IO ()
298readWord8 inh = S.drain $ S.unfold FH.read inh
300{-# INLINE decodeChar8 #-}
301decodeChar8 :: Handle -> IO ()
305 $ S.unfold FH.read inh
308{-# INLINE copyCodecChar8 #-}
309copyCodecChar8 :: Handle -> Handle -> IO ()
310copyCodecChar8 inh outh =
311 S.fold (FH.write outh)
314 $ S.unfold FH.read inh
317inspect $ hasNoTypeClasses 'copyCodecChar8
318inspect $ 'copyCodecChar8 `hasNoType` ''Step
319inspect $ 'copyCodecChar8 `hasNoType` ''AT.FlattenState
320inspect $ 'copyCodecChar8 `hasNoType` ''D.ConcatMapUState
323{-# INLINE decodeUtf8Lenient #-}
324decodeUtf8Lenient :: Handle -> IO ()
325decodeUtf8Lenient inh =
327 $ SS.decodeUtf8Lenient
328 $ S.unfold FH.read inh
331inspect $ hasNoTypeClasses 'decodeUtf8Lenient
332-- inspect $ 'decodeUtf8Lenient `hasNoType` ''Step
333-- inspect $ 'decodeUtf8Lenient `hasNoType` ''AT.FlattenState
334-- inspect $ 'decodeUtf8Lenient `hasNoType` ''D.ConcatMapUState
338{-# INLINE copyCodecUtf8 #-}
339copyCodecUtf8 :: Handle -> Handle -> IO ()
340copyCodecUtf8 inh outh =
341 S.fold (FH.write outh)
344 $ S.unfold FH.read inh
347inspect $ hasNoTypeClasses 'copyCodecUtf8
348-- inspect $ 'copyCodecUtf8 `hasNoType` ''Step
349-- inspect $ 'copyCodecUtf8 `hasNoType` ''AT.FlattenState
350-- inspect $ 'copyCodecUtf8 `hasNoType` ''D.ConcatMapUState
354{-# INLINE copyCodecUtf8Lenient #-}
355copyCodecUtf8Lenient :: Handle -> Handle -> IO ()
356copyCodecUtf8Lenient inh outh =
357 S.fold (FH.write outh)
359 $ SS.decodeUtf8Lenient
360 $ S.unfold FH.read inh
363inspect $ hasNoTypeClasses 'copyCodecUtf8Lenient
364-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''Step
365-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''AT.FlattenState
366-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''D.ConcatMapUState
369-- | Slice in chunks of size n and get the count of chunks.
370{-# INLINE chunksOf #-}
371chunksOf :: Int -> Handle -> IO Int
373 -- writeNUnsafe gives 2.5x boost here over writeN.
374 S.length $ S.chunksOf n (AT.writeNUnsafe n) (S.unfold FH.read inh)
377inspect $ hasNoTypeClasses 'chunksOf
378inspect $ 'chunksOf `hasNoType` ''Step
379inspect $ 'chunksOf `hasNoType` ''AT.FlattenState
380inspect $ 'chunksOf `hasNoType` ''D.ConcatMapUState
381inspect $ 'chunksOf `hasNoType` ''GroupState
384-- This is to make sure that the concatMap in FH.read, groupsOf and foldlM'
387-- | Slice in chunks of size n and get the count of chunks.
388{-# INLINE chunksOfD #-}
389chunksOfD :: Int -> Handle -> IO Int
391 D.foldlM' (\i _ -> return $ i + 1) 0
392 $ D.groupsOf n (AT.writeNUnsafe n)
393 $ D.fromStreamK (S.unfold FH.read inh)
396inspect $ hasNoTypeClasses 'chunksOf
397inspect $ 'chunksOf `hasNoType` ''Step
398inspect $ 'chunksOfD `hasNoType` ''GroupState
399inspect $ 'chunksOfD `hasNoType` ''AT.FlattenState
400inspect $ 'chunksOfD `hasNoType` ''D.ConcatMapUState
403-- XXX splitSuffixOn requires -funfolding-use-threshold=150 for better fusion
404-- | Lines and unlines
405{-# INLINE linesUnlinesCopy #-}
406linesUnlinesCopy :: Handle -> Handle -> IO ()
407linesUnlinesCopy inh outh =
408 S.fold (FH.write outh)
413 $ S.unfold FH.read inh
416inspect $ hasNoTypeClassesExcept 'linesUnlinesCopy [''Storable]
417-- inspect $ 'linesUnlinesCopy `hasNoType` ''Step
418-- inspect $ 'linesUnlinesCopy `hasNoType` ''AT.FlattenState
419-- inspect $ 'linesUnlinesCopy `hasNoType` ''D.ConcatMapUState
422foreign import ccall unsafe "u_iswspace"
423 iswspace :: Int -> Int
425-- Code copied from base/Data.Char to INLINE it
426{-# INLINE isSpace #-}
427isSpace :: Char -> Bool
428-- isSpace includes non-breaking space
429-- The magic 0x377 isn't really that magical. As of 2014, all the codepoints
430-- at or below 0x377 have been assigned, so we shouldn't have to worry about
431-- any new spaces appearing below there. It would probably be best to
432-- use branchless ||, but currently the eqLit transformation will undo that,
433-- so we'll do it like this until there's a way around that.
435 | uc <= 0x377 = uc == 32 || uc - 0x9 <= 4 || uc == 0xa0
436 | otherwise = iswspace (ord c) /= 0
438 uc = fromIntegral (ord c) :: Word
442isSp = isSpace . chr . fromIntegral
444-- | Word, unwords and copy
445{-# INLINE wordsUnwordsCopyWord8 #-}
446wordsUnwordsCopyWord8 :: Handle -> Handle -> IO ()
447wordsUnwordsCopyWord8 inh outh =
448 S.fold (FH.write outh)
449 $ S.concatUnfold IUF.fromList
451 $ S.wordsBy isSp FL.toList
452 $ S.unfold FH.read inh
455inspect $ hasNoTypeClasses 'wordsUnwordsCopyWord8
456-- inspect $ 'wordsUnwordsCopyWord8 `hasNoType` ''Step
457-- inspect $ 'wordsUnwordsCopyWord8 `hasNoType` ''D.ConcatMapUState
460-- | Word, unwords and copy
461{-# INLINE wordsUnwordsCopy #-}
462wordsUnwordsCopy :: Handle -> Handle -> IO ()
463wordsUnwordsCopy inh outh =
464 S.fold (FH.write outh)
466 $ S.concatUnfold IUF.fromList
468 -- Array allocation is too expensive for such small strings. So just use
474 -- XXX This pipeline does not fuse with wordsBy but fuses with splitOn
475 -- with -funfolding-use-threshold=300. With wordsBy it does not fuse
476 -- even with high limits for inlining and spec-constr ghc options. With
477 -- -funfolding-use-threshold=400 it performs pretty well and there
478 -- is no evidence in the core that a join point involving Step
479 -- constructors is not getting inlined. Not being able to fuse at all in
480 -- this case could be an unknown issue, need more investigation.
481 $ S.wordsBy isSpace FL.toList
482 -- -- $ S.splitOn isSpace FL.toList
484 $ S.unfold FH.read inh
487-- inspect $ hasNoTypeClasses 'wordsUnwordsCopy
488-- inspect $ 'wordsUnwordsCopy `hasNoType` ''Step
489-- inspect $ 'wordsUnwordsCopy `hasNoType` ''AT.FlattenState
490-- inspect $ 'wordsUnwordsCopy `hasNoType` ''D.ConcatMapUState
494lf = fromIntegral (ord '\n')
496toarr :: String -> A.Array Word8
497toarr = A.fromList . map (fromIntegral . ord)
499-- | Split on line feed.
500{-# INLINE splitOn #-}
501splitOn :: Handle -> IO Int
503 (S.length $ S.splitOn (== lf) FL.drain
504 $ S.unfold FH.read inh) -- >>= print
507inspect $ hasNoTypeClasses 'splitOn
508inspect $ 'splitOn `hasNoType` ''Step
509inspect $ 'splitOn `hasNoType` ''AT.FlattenState
510inspect $ 'splitOn `hasNoType` ''D.ConcatMapUState
513-- | Split suffix on line feed.
514{-# INLINE splitOnSuffix #-}
515splitOnSuffix :: Handle -> IO Int
517 (S.length $ S.splitOnSuffix (== lf) FL.drain
518 $ S.unfold FH.read inh) -- >>= print
521inspect $ hasNoTypeClasses 'splitOnSuffix
522inspect $ 'splitOnSuffix `hasNoType` ''Step
523inspect $ 'splitOnSuffix `hasNoType` ''AT.FlattenState
524inspect $ 'splitOnSuffix `hasNoType` ''D.ConcatMapUState
528{-# INLINE wordsBy #-}
529wordsBy :: Handle -> IO Int
531 (S.length $ S.wordsBy isSp FL.drain
532 $ S.unfold FH.read inh) -- >>= print
535inspect $ hasNoTypeClasses 'wordsBy
536inspect $ 'wordsBy `hasNoType` ''Step
537inspect $ 'wordsBy `hasNoType` ''AT.FlattenState
538inspect $ 'wordsBy `hasNoType` ''D.ConcatMapUState
541-- | Split on a word8 sequence.
542{-# INLINE splitOnSeq #-}
543splitOnSeq :: String -> Handle -> IO Int
545 (S.length $ IP.splitOnSeq (toarr str) FL.drain
546 $ S.unfold FH.read inh) -- >>= print
549inspect $ hasNoTypeClasses 'splitOnSeq
550-- inspect $ 'splitOnSeq `hasNoType` ''Step
551-- inspect $ 'splitOnSeq `hasNoType` ''AT.FlattenState
552-- inspect $ 'splitOnSeq `hasNoType` ''D.ConcatMapUState
555-- | Split on a character sequence.
556{-# INLINE splitOnSeqUtf8 #-}
557splitOnSeqUtf8 :: String -> Handle -> IO Int
558splitOnSeqUtf8 str inh =
559 (S.length $ IP.splitOnSeq (A.fromList str) FL.drain
560 $ SS.decodeUtf8ArraysLenient
561 $ IFH.toStreamArrays inh) -- >>= print
563-- | Split on suffix sequence.
564{-# INLINE splitOnSuffixSeq #-}
565splitOnSuffixSeq :: String -> Handle -> IO Int
566splitOnSuffixSeq str inh =
567 (S.length $ IP.splitOnSuffixSeq (toarr str) FL.drain
568 $ S.unfold FH.read inh) -- >>= print
571inspect $ hasNoTypeClasses 'splitOnSuffixSeq
572-- inspect $ 'splitOnSuffixSeq `hasNoType` ''Step
573-- inspect $ 'splitOnSuffixSeq `hasNoType` ''AT.FlattenState
574-- 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