git.iko.soy/streamly
on ecb846d help sign in
streamly/src/Streamly/Benchmark/FileIO/Array.hs
242 lines 6.9 kB history raw
1-- |
2-- Module : Streamly.Benchmark.FileIO.Array
3-- Copyright : (c) 2019 Composewell Technologies
4--
5-- License : BSD3
6-- Maintainer : streamly@composewell.com
7-- Stability : experimental
8-- Portability : GHC
10{-# LANGUAGE CPP #-}
12#ifdef __HADDOCK_VERSION__
13#undef INSPECTION
14#endif
16#ifdef INSPECTION
17{-# LANGUAGE TemplateHaskell #-}
18{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
19#endif
21module Streamly.Benchmark.FileIO.Array
22 (
23 last
24 , countBytes
25 , countLines
26 , countWords
27 , sumBytes
28 , cat
29 , catOnException
30 , catBracket
31 , catBracketStream
32 , copy
33 , linesUnlinesCopy
34 , wordsUnwordsCopy
35 , decodeUtf8Lenient
36 , copyCodecUtf8Lenient
37 )
38where
40import Data.Functor.Identity (runIdentity)
41import Data.Word (Word8)
42import System.IO (Handle, hClose)
43import Prelude hiding (last)
45import qualified Streamly.FileSystem.Handle as FH
46import qualified Streamly.Memory.Array as A
47import qualified Streamly.Prelude as S
48import qualified Streamly.Data.Unicode.Stream as SS
49import qualified Streamly.Internal.Data.Unicode.Stream as IUS
51import qualified Streamly.Internal.FileSystem.Handle as IFH
52import qualified Streamly.Internal.Memory.Array as IA
53import qualified Streamly.Internal.Memory.ArrayStream as AS
54import qualified Streamly.Internal.Data.Unfold as IUF
56#ifdef INSPECTION
57import Foreign.Storable (Storable)
58import Streamly.Internal.Data.Stream.StreamD.Type (Step(..))
59import Test.Inspection
60#endif
62-- | Get the last byte from a file bytestream.
63{-# INLINE last #-}
64last :: Handle -> IO (Maybe Word8)
65last inh = do
66 let s = IFH.toChunks inh
67 larr <- S.last s
68 return $ case larr of
69 Nothing -> Nothing
70 Just arr -> IA.readIndex arr (A.length arr - 1)
72#ifdef INSPECTION
73inspect $ hasNoTypeClasses 'last
74inspect $ 'last `hasNoType` ''Step
75#endif
77-- | Count the number of bytes in a file.
78{-# INLINE countBytes #-}
79countBytes :: Handle -> IO Int
80countBytes inh =
81 let s = IFH.toChunks inh
82 in S.sum (S.map A.length s)
84#ifdef INSPECTION
85inspect $ hasNoTypeClasses 'countBytes
86inspect $ 'countBytes `hasNoType` ''Step
87#endif
89-- | Count the number of lines in a file.
90{-# INLINE countLines #-}
91countLines :: Handle -> IO Int
92countLines = S.length . AS.splitOnSuffix 10 . IFH.toChunks
94#ifdef INSPECTION
95inspect $ hasNoTypeClasses 'countLines
96inspect $ 'countLines `hasNoType` ''Step
97#endif
99-- XXX use a word splitting combinator instead of splitOn and test it.
100-- | Count the number of lines in a file.
101{-# INLINE countWords #-}
102countWords :: Handle -> IO Int
103countWords = S.length . AS.splitOn 32 . IFH.toChunks
105#ifdef INSPECTION
106inspect $ hasNoTypeClasses 'countWords
107inspect $ 'countWords `hasNoType` ''Step
108#endif
110-- | Sum the bytes in a file.
111{-# INLINE sumBytes #-}
112sumBytes :: Handle -> IO Word8
113sumBytes inh = do
114 let foldlArr' f z = runIdentity . S.foldl' f z . IA.toStream
115 let s = IFH.toChunks inh
116 S.foldl' (\acc arr -> acc + foldlArr' (+) 0 arr) 0 s
118#ifdef INSPECTION
119inspect $ hasNoTypeClasses 'sumBytes
120inspect $ 'sumBytes `hasNoType` ''Step
121#endif
123-- | Send the file contents to /dev/null
124{-# INLINE cat #-}
125cat :: Handle -> Handle -> IO ()
126cat devNull inh =
127 S.fold (IFH.writeChunks devNull) $ IFH.toChunksWithBufferOf (256*1024) inh
129#ifdef INSPECTION
130inspect $ hasNoTypeClasses 'cat
131inspect $ 'cat `hasNoType` ''Step
132#endif
134-- | Send the file contents to /dev/null with exception handling
135{-# INLINE catBracket #-}
136catBracket :: Handle -> Handle -> IO ()
137catBracket devNull inh =
138 let readEx = IUF.bracket return (\_ -> hClose inh)
139 (IUF.supplyFirst FH.readChunksWithBufferOf (256*1024))
140 in IUF.fold readEx (IFH.writeChunks devNull) inh
142#ifdef INSPECTION
143inspect $ hasNoTypeClasses 'catBracket
144-- inspect $ 'catBracket `hasNoType` ''Step
145#endif
147-- | Send the file contents to /dev/null with exception handling
148{-# INLINE catBracketStream #-}
149catBracketStream :: Handle -> Handle -> IO ()
150catBracketStream devNull inh =
151 let readEx = S.bracket (return ()) (\_ -> hClose inh)
152 (\_ -> IFH.toChunksWithBufferOf (256*1024) inh)
153 in S.fold (IFH.writeChunks devNull) $ readEx
155#ifdef INSPECTION
156inspect $ hasNoTypeClasses 'catBracketStream
157-- inspect $ 'catBracketStream `hasNoType` ''Step
158#endif
160-- | Send the file contents to /dev/null with exception handling
161{-# INLINE catOnException #-}
162catOnException :: Handle -> Handle -> IO ()
163catOnException devNull inh =
164 let readEx = IUF.onException (\_ -> hClose inh)
165 (IUF.supplyFirst FH.readChunksWithBufferOf (256*1024))
166 in IUF.fold readEx (IFH.writeChunks devNull) inh
168#ifdef INSPECTION
169inspect $ hasNoTypeClasses 'catOnException
170-- inspect $ 'catOnException `hasNoType` ''Step
171#endif
173-- | Copy file
174{-# INLINE copy #-}
175copy :: Handle -> Handle -> IO ()
176copy inh outh =
177 let s = IFH.toChunks inh
178 in S.fold (IFH.writeChunks outh) s
180#ifdef INSPECTION
181inspect $ hasNoTypeClasses 'copy
182inspect $ 'copy `hasNoType` ''Step
183#endif
185-- | Lines and unlines
186{-# INLINE linesUnlinesCopy #-}
187linesUnlinesCopy :: Handle -> Handle -> IO ()
188linesUnlinesCopy inh outh =
189 S.fold (IFH.writeWithBufferOf (1024*1024) outh)
190 $ AS.interposeSuffix 10
191 $ AS.splitOnSuffix 10
192 $ IFH.toChunksWithBufferOf (1024*1024) inh
194#ifdef INSPECTION
195inspect $ hasNoTypeClassesExcept 'linesUnlinesCopy [''Storable]
196-- inspect $ 'linesUnlinesCopy `hasNoType` ''Step
197#endif
199-- | Words and unwords
200{-# INLINE wordsUnwordsCopy #-}
201wordsUnwordsCopy :: Handle -> Handle -> IO ()
202wordsUnwordsCopy inh outh =
203 S.fold (IFH.writeWithBufferOf (1024*1024) outh)
204 $ AS.interpose 32
205 -- XXX this is not correct word splitting combinator
206 $ AS.splitOn 32
207 $ IFH.toChunksWithBufferOf (1024*1024) inh
209#ifdef INSPECTION
210inspect $ hasNoTypeClassesExcept 'wordsUnwordsCopy [''Storable]
211-- inspect $ 'wordsUnwordsCopy `hasNoType` ''Step
212#endif
214{-# INLINE decodeUtf8Lenient #-}
215decodeUtf8Lenient :: Handle -> IO ()
216decodeUtf8Lenient inh =
217 S.drain
218 $ IUS.decodeUtf8ArraysLenient
219 $ IFH.toChunksWithBufferOf (1024*1024) inh
221#ifdef INSPECTION
222inspect $ hasNoTypeClasses 'decodeUtf8Lenient
223-- inspect $ 'decodeUtf8Lenient `hasNoType` ''Step
224-- inspect $ 'decodeUtf8Lenient `hasNoType` ''AT.FlattenState
225-- inspect $ 'decodeUtf8Lenient `hasNoType` ''D.ConcatMapUState
226#endif
228-- | Copy file
229{-# INLINE copyCodecUtf8Lenient #-}
230copyCodecUtf8Lenient :: Handle -> Handle -> IO ()
231copyCodecUtf8Lenient inh outh =
232 S.fold (FH.write outh)
233 $ SS.encodeUtf8
234 $ IUS.decodeUtf8ArraysLenient
235 $ IFH.toChunksWithBufferOf (1024*1024) inh
237#ifdef INSPECTION
238inspect $ hasNoTypeClasses 'copyCodecUtf8Lenient
239-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''Step
240-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''AT.FlattenState
241-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''D.ConcatMapUState
242#endif