git.iko.soy/streamly
on 745265e help sign in
streamly/benchmark/Streamly/Benchmark/FileIO/Array.hs
259 lines 7.6 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 , catBracketIO
32 , catBracketStream
33 , catBracketStreamIO
34 , copy
35 , linesUnlinesCopy
36 , wordsUnwordsCopy
37 , decodeUtf8Lenient
38 , copyCodecUtf8Lenient
39 )
40where
42import Data.Functor.Identity (runIdentity)
43import Data.Word (Word8)
44import System.IO (Handle, hClose)
45import Prelude hiding (last)
47import qualified Streamly.FileSystem.Handle as FH
48import qualified Streamly.Memory.Array as A
49import qualified Streamly.Prelude as S
50import qualified Streamly.Data.Unicode.Stream as SS
51import qualified Streamly.Internal.Data.Unicode.Stream as IUS
53import qualified Streamly.Internal.FileSystem.Handle as IFH
54import qualified Streamly.Internal.Memory.Array as IA
55import qualified Streamly.Internal.Memory.ArrayStream as AS
56import qualified Streamly.Internal.Data.Unfold as IUF
57import qualified Streamly.Internal.Prelude as IP
59#ifdef INSPECTION
60import Foreign.Storable (Storable)
61import Streamly.Internal.Data.Stream.StreamD.Type (Step(..))
62import Test.Inspection
63#endif
65-- | Get the last byte from a file bytestream.
66{-# INLINE last #-}
67last :: Handle -> IO (Maybe Word8)
68last inh = do
69 let s = IFH.toChunks inh
70 larr <- S.last s
71 return $ case larr of
72 Nothing -> Nothing
73 Just arr -> IA.readIndex arr (A.length arr - 1)
75#ifdef INSPECTION
76inspect $ hasNoTypeClasses 'last
77inspect $ 'last `hasNoType` ''Step
78#endif
80-- | Count the number of bytes in a file.
81{-# INLINE countBytes #-}
82countBytes :: Handle -> IO Int
83countBytes inh =
84 let s = IFH.toChunks inh
85 in S.sum (S.map A.length s)
87#ifdef INSPECTION
88inspect $ hasNoTypeClasses 'countBytes
89inspect $ 'countBytes `hasNoType` ''Step
90#endif
92-- | Count the number of lines in a file.
93{-# INLINE countLines #-}
94countLines :: Handle -> IO Int
95countLines = S.length . AS.splitOnSuffix 10 . IFH.toChunks
97#ifdef INSPECTION
98inspect $ hasNoTypeClasses 'countLines
99inspect $ 'countLines `hasNoType` ''Step
100#endif
102-- XXX use a word splitting combinator instead of splitOn and test it.
103-- | Count the number of lines in a file.
104{-# INLINE countWords #-}
105countWords :: Handle -> IO Int
106countWords = S.length . AS.splitOn 32 . IFH.toChunks
108#ifdef INSPECTION
109inspect $ hasNoTypeClasses 'countWords
110inspect $ 'countWords `hasNoType` ''Step
111#endif
113-- | Sum the bytes in a file.
114{-# INLINE sumBytes #-}
115sumBytes :: Handle -> IO Word8
116sumBytes inh = do
117 let foldlArr' f z = runIdentity . S.foldl' f z . IA.toStream
118 let s = IFH.toChunks inh
119 S.foldl' (\acc arr -> acc + foldlArr' (+) 0 arr) 0 s
121#ifdef INSPECTION
122inspect $ hasNoTypeClasses 'sumBytes
123inspect $ 'sumBytes `hasNoType` ''Step
124#endif
126-- | Send the file contents to /dev/null
127{-# INLINE cat #-}
128cat :: Handle -> Handle -> IO ()
129cat devNull inh =
130 S.fold (IFH.writeChunks devNull) $ IFH.toChunksWithBufferOf (256*1024) inh
132#ifdef INSPECTION
133inspect $ hasNoTypeClasses 'cat
134inspect $ 'cat `hasNoType` ''Step
135#endif
137-- | Send the file contents to /dev/null with exception handling
138{-# INLINE catBracket #-}
139catBracket :: Handle -> Handle -> IO ()
140catBracket devNull inh =
141 let readEx = IUF.bracket return (\_ -> hClose inh)
142 (IUF.supplyFirst FH.readChunksWithBufferOf (256*1024))
143 in IUF.fold readEx (IFH.writeChunks devNull) inh
145#ifdef INSPECTION
146inspect $ hasNoTypeClasses 'catBracket
147-- inspect $ 'catBracket `hasNoType` ''Step
148#endif
150{-# INLINE catBracketIO #-}
151catBracketIO :: Handle -> Handle -> IO ()
152catBracketIO devNull inh =
153 let readEx = IUF.bracketIO return (\_ -> hClose inh)
154 (IUF.supplyFirst FH.readChunksWithBufferOf (256*1024))
155 in IUF.fold readEx (IFH.writeChunks devNull) inh
157-- | Send the file contents to /dev/null with exception handling
158{-# INLINE catBracketStream #-}
159catBracketStream :: Handle -> Handle -> IO ()
160catBracketStream devNull inh =
161 let readEx = S.bracket (return ()) (\_ -> hClose inh)
162 (\_ -> IFH.toChunksWithBufferOf (256*1024) inh)
163 in S.fold (IFH.writeChunks devNull) $ readEx
165#ifdef INSPECTION
166inspect $ hasNoTypeClasses 'catBracketStream
167-- inspect $ 'catBracketStream `hasNoType` ''Step
168#endif
170{-# INLINE catBracketStreamIO #-}
171catBracketStreamIO :: Handle -> Handle -> IO ()
172catBracketStreamIO devNull inh =
173 let readEx = IP.bracketIO (return ()) (\_ -> hClose inh)
174 (\_ -> IFH.toChunksWithBufferOf (256*1024) inh)
175 in S.fold (IFH.writeChunks devNull) $ readEx
177-- | Send the file contents to /dev/null with exception handling
178{-# INLINE catOnException #-}
179catOnException :: Handle -> Handle -> IO ()
180catOnException devNull inh =
181 let readEx = IUF.onException (\_ -> hClose inh)
182 (IUF.supplyFirst FH.readChunksWithBufferOf (256*1024))
183 in IUF.fold readEx (IFH.writeChunks devNull) inh
185#ifdef INSPECTION
186inspect $ hasNoTypeClasses 'catOnException
187-- inspect $ 'catOnException `hasNoType` ''Step
188#endif
190-- | Copy file
191{-# INLINE copy #-}
192copy :: Handle -> Handle -> IO ()
193copy inh outh =
194 let s = IFH.toChunks inh
195 in S.fold (IFH.writeChunks outh) s
197#ifdef INSPECTION
198inspect $ hasNoTypeClasses 'copy
199inspect $ 'copy `hasNoType` ''Step
200#endif
202-- | Lines and unlines
203{-# INLINE linesUnlinesCopy #-}
204linesUnlinesCopy :: Handle -> Handle -> IO ()
205linesUnlinesCopy inh outh =
206 S.fold (IFH.writeWithBufferOf (1024*1024) outh)
207 $ AS.interposeSuffix 10
208 $ AS.splitOnSuffix 10
209 $ IFH.toChunksWithBufferOf (1024*1024) inh
211#ifdef INSPECTION
212inspect $ hasNoTypeClassesExcept 'linesUnlinesCopy [''Storable]
213-- inspect $ 'linesUnlinesCopy `hasNoType` ''Step
214#endif
216-- | Words and unwords
217{-# INLINE wordsUnwordsCopy #-}
218wordsUnwordsCopy :: Handle -> Handle -> IO ()
219wordsUnwordsCopy inh outh =
220 S.fold (IFH.writeWithBufferOf (1024*1024) outh)
221 $ AS.interpose 32
222 -- XXX this is not correct word splitting combinator
223 $ AS.splitOn 32
224 $ IFH.toChunksWithBufferOf (1024*1024) inh
226#ifdef INSPECTION
227inspect $ hasNoTypeClassesExcept 'wordsUnwordsCopy [''Storable]
228-- inspect $ 'wordsUnwordsCopy `hasNoType` ''Step
229#endif
231{-# INLINE decodeUtf8Lenient #-}
232decodeUtf8Lenient :: Handle -> IO ()
233decodeUtf8Lenient inh =
234 S.drain
235 $ IUS.decodeUtf8ArraysLenient
236 $ IFH.toChunksWithBufferOf (1024*1024) inh
238#ifdef INSPECTION
239inspect $ hasNoTypeClasses 'decodeUtf8Lenient
240-- inspect $ 'decodeUtf8Lenient `hasNoType` ''Step
241-- inspect $ 'decodeUtf8Lenient `hasNoType` ''AT.FlattenState
242-- inspect $ 'decodeUtf8Lenient `hasNoType` ''D.ConcatMapUState
243#endif
245-- | Copy file
246{-# INLINE copyCodecUtf8Lenient #-}
247copyCodecUtf8Lenient :: Handle -> Handle -> IO ()
248copyCodecUtf8Lenient inh outh =
249 S.fold (FH.write outh)
250 $ SS.encodeUtf8
251 $ IUS.decodeUtf8ArraysLenient
252 $ IFH.toChunksWithBufferOf (1024*1024) inh
254#ifdef INSPECTION
255inspect $ hasNoTypeClasses 'copyCodecUtf8Lenient
256-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''Step
257-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''AT.FlattenState
258-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''D.ConcatMapUState
259#endif