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
40 , wordsUnwordsCopyWord8
47 , copyCodecUtf8Lenient
59import Control.Exception (SomeException)
60import Data.Char (ord, chr)
61import Data.Word (Word8)
62import System.IO (Handle, hClose)
63import Prelude hiding (last, length)
65import qualified Streamly.FileSystem.Handle as FH
66import qualified Streamly.Internal.FileSystem.Handle as IFH
67import qualified Streamly.Memory.Array as A
68import qualified Streamly.Internal.Memory.Array.Types as AT
69import qualified Streamly.Prelude as S
70import qualified Streamly.Data.Fold as FL
71import qualified Streamly.Data.String as SS
72import qualified Streamly.Internal.Data.Unfold as IUF
73import qualified Streamly.Internal.Prelude as IP
74import qualified Streamly.Streams.StreamD as D
77import Foreign.Storable (Storable)
78import Streamly.Streams.StreamD.Type (Step(..), GroupState)
82-- | Get the last byte from a file bytestream.
84last :: Handle -> IO (Maybe Word8)
85last = S.last . S.unfold FH.read
88inspect $ hasNoTypeClasses 'last
89inspect $ 'last `hasNoType` ''Step
90inspect $ 'last `hasNoType` ''AT.FlattenState
91inspect $ 'last `hasNoType` ''D.ConcatMapUState
94-- assert that flattenArrays constructors are not present
95-- | Count the number of bytes in a file.
96{-# INLINE countBytes #-}
97countBytes :: Handle -> IO Int
98countBytes = S.length . S.unfold FH.read
101inspect $ hasNoTypeClasses 'countBytes
102inspect $ 'countBytes `hasNoType` ''Step
103inspect $ 'countBytes `hasNoType` ''AT.FlattenState
104inspect $ 'countBytes `hasNoType` ''D.ConcatMapUState
107-- | Count the number of lines in a file.
108{-# INLINE countLines #-}
109countLines :: Handle -> IO Int
112 . SS.foldLines FL.drain
117inspect $ hasNoTypeClasses 'countLines
118inspect $ 'countLines `hasNoType` ''Step
119inspect $ 'countLines `hasNoType` ''AT.FlattenState
120inspect $ 'countLines `hasNoType` ''D.ConcatMapUState
123-- | Count the number of words in a file.
124{-# INLINE countWords #-}
125countWords :: Handle -> IO Int
128 . SS.foldWords FL.drain
133inspect $ hasNoTypeClasses 'countWords
134-- inspect $ 'countWords `hasNoType` ''Step
135-- inspect $ 'countWords `hasNoType` ''D.ConcatMapUState
138-- | Count the number of lines in a file.
139{-# INLINE countLinesU #-}
140countLinesU :: Handle -> IO Int
143 $ SS.foldLines FL.drain
145 $ S.concatUnfold A.read (IFH.toStreamArrays inh)
148inspect $ hasNoTypeClasses 'countLinesU
149inspect $ 'countLinesU `hasNoType` ''Step
150inspect $ 'countLinesU `hasNoType` ''D.ConcatMapUState
153-- | Sum the bytes in a file.
154{-# INLINE sumBytes #-}
155sumBytes :: Handle -> IO Word8
156sumBytes = S.sum . S.unfold FH.read
159inspect $ hasNoTypeClasses 'sumBytes
160inspect $ 'sumBytes `hasNoType` ''Step
161inspect $ 'sumBytes `hasNoType` ''AT.FlattenState
162inspect $ 'sumBytes `hasNoType` ''D.ConcatMapUState
165-- | Send the file contents to /dev/null
167cat :: Handle -> Handle -> IO ()
168cat devNull inh = S.fold (FH.write devNull) $ S.unfold FH.read inh
171inspect $ hasNoTypeClasses 'cat
172inspect $ 'cat `hasNoType` ''Step
173inspect $ 'cat `hasNoType` ''AT.FlattenState
174inspect $ 'cat `hasNoType` ''D.ConcatMapUState
177-- | Send the file contents to /dev/null
178{-# INLINE catStreamWrite #-}
179catStreamWrite :: Handle -> Handle -> IO ()
180catStreamWrite devNull inh = IFH.fromStream devNull $ S.unfold FH.read inh
183inspect $ hasNoTypeClasses 'catStreamWrite
184inspect $ 'catStreamWrite `hasNoType` ''Step
185inspect $ 'catStreamWrite `hasNoType` ''AT.FlattenState
186inspect $ 'catStreamWrite `hasNoType` ''D.ConcatMapUState
189-- | Send the file contents to /dev/null with exception handling
190{-# INLINE catBracket #-}
191catBracket :: Handle -> Handle -> IO ()
192catBracket devNull inh =
193 let readEx = IUF.bracket return (\_ -> hClose inh) FH.read
194 in S.fold (FH.write devNull) $ S.unfold readEx inh
197inspect $ hasNoTypeClasses 'catBracket
198-- inspect $ 'catBracket `hasNoType` ''Step
199-- inspect $ 'catBracket `hasNoType` ''AT.FlattenState
200-- inspect $ 'catBracket `hasNoType` ''D.ConcatMapUState
203-- | Send the file contents to /dev/null with exception handling
204{-# INLINE catBracketStream #-}
205catBracketStream :: Handle -> Handle -> IO ()
206catBracketStream devNull inh =
207 let readEx = S.bracket (return ()) (\_ -> hClose inh)
208 (\_ -> IFH.toStream inh)
209 in IFH.fromStream devNull $ readEx
212inspect $ hasNoTypeClasses 'catBracketStream
213-- inspect $ 'catBracketStream `hasNoType` ''Step
216-- | Send the file contents to /dev/null with exception handling
217{-# INLINE catOnException #-}
218catOnException :: Handle -> Handle -> IO ()
219catOnException devNull inh =
220 let readEx = IUF.onException (\_ -> hClose inh) FH.read
221 in S.fold (FH.write devNull) $ S.unfold readEx inh
224inspect $ hasNoTypeClasses 'catOnException
225-- inspect $ 'catOnException `hasNoType` ''Step
226-- inspect $ 'catOnException `hasNoType` ''AT.FlattenState
227-- inspect $ 'catOnException `hasNoType` ''D.ConcatMapUState
230-- | Send the file contents to /dev/null with exception handling
231{-# INLINE catFinally #-}
232catFinally :: Handle -> Handle -> IO ()
233catFinally devNull inh =
234 let readEx = IUF.finally (\_ -> hClose inh) FH.read
235 in S.fold (FH.write devNull) $ S.unfold readEx inh
238inspect $ hasNoTypeClasses 'catFinally
239-- inspect $ 'catFinally `hasNoType` ''Step
240-- inspect $ 'catFinally `hasNoType` ''AT.FlattenState
241-- inspect $ 'catFinally `hasNoType` ''D.ConcatMapUState
244-- | Send the file contents to /dev/null with exception handling
245{-# INLINE catHandle #-}
246catHandle :: Handle -> Handle -> IO ()
247catHandle devNull inh =
248 let readEx = IUF.handle (\(_e :: SomeException) -> hClose inh >> return 10)
250 in S.fold (FH.write devNull) $ S.unfold readEx inh
253inspect $ hasNoTypeClasses 'catHandle
254-- inspect $ 'catHandle `hasNoType` ''Step
255-- inspect $ 'catHandle `hasNoType` ''AT.FlattenState
256-- inspect $ 'catHandle `hasNoType` ''D.ConcatMapUState
261copy :: Handle -> Handle -> IO ()
262copy inh outh = S.fold (FH.write outh) (S.unfold FH.read inh)
265inspect $ hasNoTypeClasses 'copy
266inspect $ 'copy `hasNoType` ''Step
267inspect $ 'copy `hasNoType` ''AT.FlattenState
268inspect $ 'copy `hasNoType` ''D.ConcatMapUState
271{-# INLINE readWord8 #-}
272readWord8 :: Handle -> IO ()
273readWord8 inh = S.drain $ S.unfold FH.read inh
275{-# INLINE decodeChar8 #-}
276decodeChar8 :: Handle -> IO ()
280 $ S.unfold FH.read inh
283{-# INLINE copyCodecChar8 #-}
284copyCodecChar8 :: Handle -> Handle -> IO ()
285copyCodecChar8 inh outh =
286 S.fold (FH.write outh)
289 $ S.unfold FH.read inh
292inspect $ hasNoTypeClasses 'copyCodecChar8
293inspect $ 'copyCodecChar8 `hasNoType` ''Step
294inspect $ 'copyCodecChar8 `hasNoType` ''AT.FlattenState
295inspect $ 'copyCodecChar8 `hasNoType` ''D.ConcatMapUState
298{-# INLINE decodeUtf8Lenient #-}
299decodeUtf8Lenient :: Handle -> IO ()
300decodeUtf8Lenient inh =
302 $ SS.decodeUtf8Lenient
303 $ S.unfold FH.read inh
306inspect $ hasNoTypeClasses 'decodeUtf8Lenient
307-- inspect $ 'decodeUtf8Lenient `hasNoType` ''Step
308-- inspect $ 'decodeUtf8Lenient `hasNoType` ''AT.FlattenState
309-- inspect $ 'decodeUtf8Lenient `hasNoType` ''D.ConcatMapUState
313{-# INLINE copyCodecUtf8 #-}
314copyCodecUtf8 :: Handle -> Handle -> IO ()
315copyCodecUtf8 inh outh =
316 S.fold (FH.write outh)
319 $ S.unfold FH.read inh
322inspect $ hasNoTypeClasses 'copyCodecUtf8
323-- inspect $ 'copyCodecUtf8 `hasNoType` ''Step
324-- inspect $ 'copyCodecUtf8 `hasNoType` ''AT.FlattenState
325-- inspect $ 'copyCodecUtf8 `hasNoType` ''D.ConcatMapUState
329{-# INLINE copyCodecUtf8Lenient #-}
330copyCodecUtf8Lenient :: Handle -> Handle -> IO ()
331copyCodecUtf8Lenient inh outh =
332 S.fold (FH.write outh)
334 $ SS.decodeUtf8Lenient
335 $ S.unfold FH.read inh
338inspect $ hasNoTypeClasses 'copyCodecUtf8Lenient
339-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''Step
340-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''AT.FlattenState
341-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''D.ConcatMapUState
344-- | Slice in chunks of size n and get the count of chunks.
345{-# INLINE chunksOf #-}
346chunksOf :: Int -> Handle -> IO Int
348 -- writeNUnsafe gives 2.5x boost here over writeN.
349 S.length $ S.chunksOf n (AT.writeNUnsafe n) (S.unfold FH.read inh)
352inspect $ hasNoTypeClasses 'chunksOf
353inspect $ 'chunksOf `hasNoType` ''Step
354inspect $ 'chunksOf `hasNoType` ''AT.FlattenState
355inspect $ 'chunksOf `hasNoType` ''D.ConcatMapUState
356inspect $ 'chunksOf `hasNoType` ''GroupState
359-- This is to make sure that the concatMap in FH.read, groupsOf and foldlM'
362-- | Slice in chunks of size n and get the count of chunks.
363{-# INLINE chunksOfD #-}
364chunksOfD :: Int -> Handle -> IO Int
366 D.foldlM' (\i _ -> return $ i + 1) 0
367 $ D.groupsOf n (AT.writeNUnsafe n)
368 $ D.fromStreamK (S.unfold FH.read inh)
371inspect $ hasNoTypeClasses 'chunksOf
372inspect $ 'chunksOf `hasNoType` ''Step
373inspect $ 'chunksOfD `hasNoType` ''GroupState
374inspect $ 'chunksOfD `hasNoType` ''AT.FlattenState
375inspect $ 'chunksOfD `hasNoType` ''D.ConcatMapUState
378-- XXX splitSuffixOn requires -funfolding-use-threshold=150 for better fusion
379-- | Lines and unlines
380{-# INLINE linesUnlinesCopy #-}
381linesUnlinesCopy :: Handle -> Handle -> IO ()
382linesUnlinesCopy inh outh =
383 S.fold (FH.write outh)
388 $ S.unfold FH.read inh
391inspect $ hasNoTypeClassesExcept 'linesUnlinesCopy [''Storable]
392-- inspect $ 'linesUnlinesCopy `hasNoType` ''Step
393-- inspect $ 'linesUnlinesCopy `hasNoType` ''AT.FlattenState
394-- inspect $ 'linesUnlinesCopy `hasNoType` ''D.ConcatMapUState
397foreign import ccall unsafe "u_iswspace"
398 iswspace :: Int -> Int
400-- Code copied from base/Data.Char to INLINE it
401{-# INLINE isSpace #-}
402isSpace :: Char -> Bool
403-- isSpace includes non-breaking space
404-- The magic 0x377 isn't really that magical. As of 2014, all the codepoints
405-- at or below 0x377 have been assigned, so we shouldn't have to worry about
406-- any new spaces appearing below there. It would probably be best to
407-- use branchless ||, but currently the eqLit transformation will undo that,
408-- so we'll do it like this until there's a way around that.
410 | uc <= 0x377 = uc == 32 || uc - 0x9 <= 4 || uc == 0xa0
411 | otherwise = iswspace (ord c) /= 0
413 uc = fromIntegral (ord c) :: Word
417isSp = isSpace . chr . fromIntegral
419-- | Word, unwords and copy
420{-# INLINE wordsUnwordsCopyWord8 #-}
421wordsUnwordsCopyWord8 :: Handle -> Handle -> IO ()
422wordsUnwordsCopyWord8 inh outh =
423 S.fold (FH.write outh)
424 $ S.concatUnfold IUF.fromList
426 $ S.wordsBy isSp FL.toList
427 $ S.unfold FH.read inh
430inspect $ hasNoTypeClasses 'wordsUnwordsCopyWord8
431-- inspect $ 'wordsUnwordsCopyWord8 `hasNoType` ''Step
432-- inspect $ 'wordsUnwordsCopyWord8 `hasNoType` ''D.ConcatMapUState
435-- | Word, unwords and copy
436{-# INLINE wordsUnwordsCopy #-}
437wordsUnwordsCopy :: Handle -> Handle -> IO ()
438wordsUnwordsCopy inh outh =
439 S.fold (FH.write outh)
441 $ S.concatUnfold IUF.fromList
443 -- Array allocation is too expensive for such small strings. So just use
449 -- XXX This pipeline does not fuse with wordsBy but fuses with splitOn
450 -- with -funfolding-use-threshold=300. With wordsBy it does not fuse
451 -- even with high limits for inlining and spec-constr ghc options. With
452 -- -funfolding-use-threshold=400 it performs pretty well and there
453 -- is no evidence in the core that a join point involving Step
454 -- constructors is not getting inlined. Not being able to fuse at all in
455 -- this case could be an unknown issue, need more investigation.
456 $ S.wordsBy isSpace FL.toList
457 -- -- $ S.splitOn isSpace FL.toList
459 $ S.unfold FH.read inh
462-- inspect $ hasNoTypeClasses 'wordsUnwordsCopy
463-- inspect $ 'wordsUnwordsCopy `hasNoType` ''Step
464-- inspect $ 'wordsUnwordsCopy `hasNoType` ''AT.FlattenState
465-- inspect $ 'wordsUnwordsCopy `hasNoType` ''D.ConcatMapUState
469lf = fromIntegral (ord '\n')
471toarr :: String -> A.Array Word8
472toarr = A.fromList . map (fromIntegral . ord)
474-- | Split on line feed.
475{-# INLINE splitOn #-}
476splitOn :: Handle -> IO Int
478 (S.length $ S.splitOn (== lf) FL.drain
479 $ S.unfold FH.read inh) -- >>= print
482inspect $ hasNoTypeClasses 'splitOn
483inspect $ 'splitOn `hasNoType` ''Step
484inspect $ 'splitOn `hasNoType` ''AT.FlattenState
485inspect $ 'splitOn `hasNoType` ''D.ConcatMapUState
488-- | Split suffix on line feed.
489{-# INLINE splitOnSuffix #-}
490splitOnSuffix :: Handle -> IO Int
492 (S.length $ S.splitOnSuffix (== lf) FL.drain
493 $ S.unfold FH.read inh) -- >>= print
496inspect $ hasNoTypeClasses 'splitOnSuffix
497inspect $ 'splitOnSuffix `hasNoType` ''Step
498inspect $ 'splitOnSuffix `hasNoType` ''AT.FlattenState
499inspect $ 'splitOnSuffix `hasNoType` ''D.ConcatMapUState
503{-# INLINE wordsBy #-}
504wordsBy :: Handle -> IO Int
506 (S.length $ S.wordsBy isSp FL.drain
507 $ S.unfold FH.read inh) -- >>= print
510inspect $ hasNoTypeClasses 'wordsBy
511inspect $ 'wordsBy `hasNoType` ''Step
512inspect $ 'wordsBy `hasNoType` ''AT.FlattenState
513inspect $ 'wordsBy `hasNoType` ''D.ConcatMapUState
516-- | Split on a word8 sequence.
517{-# INLINE splitOnSeq #-}
518splitOnSeq :: String -> Handle -> IO Int
520 (S.length $ IP.splitOnSeq (toarr str) FL.drain
521 $ S.unfold FH.read inh) -- >>= print
524inspect $ hasNoTypeClasses 'splitOnSeq
525-- inspect $ 'splitOnSeq `hasNoType` ''Step
526-- inspect $ 'splitOnSeq `hasNoType` ''AT.FlattenState
527-- inspect $ 'splitOnSeq `hasNoType` ''D.ConcatMapUState
530-- | Split on a character sequence.
531{-# INLINE splitOnSeqUtf8 #-}
532splitOnSeqUtf8 :: String -> Handle -> IO Int
533splitOnSeqUtf8 str inh =
534 (S.length $ IP.splitOnSeq (A.fromList str) FL.drain
535 $ SS.decodeUtf8ArraysLenient
536 $ IFH.toStreamArrays inh) -- >>= print
538-- | Split on suffix sequence.
539{-# INLINE splitOnSuffixSeq #-}
540splitOnSuffixSeq :: String -> Handle -> IO Int
541splitOnSuffixSeq str inh =
542 (S.length $ IP.splitOnSuffixSeq (toarr str) FL.drain
543 $ S.unfold FH.read inh) -- >>= print
546inspect $ hasNoTypeClasses 'splitOnSuffixSeq
547-- inspect $ 'splitOnSuffixSeq `hasNoType` ''Step
548-- inspect $ 'splitOnSuffixSeq `hasNoType` ''AT.FlattenState
549-- 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