git.iko.soy/streamly
on b6a0752 help sign in
streamly/benchmark/Streamly/Benchmark/FileSystem/Handle/ReadWrite.hs
262 lines 8.9 kB history raw
1-- |
2-- Module : Streamly.Benchmark.FileSystem.Handle
3-- Copyright : (c) 2019 Composewell Technologies
4-- License : BSD3-3-Clause
5-- Maintainer : streamly@composewell.com
6-- Stability : experimental
7-- Portability : GHC
9{-# LANGUAGE CPP #-}
10{-# LANGUAGE ScopedTypeVariables #-}
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 Handle.ReadWrite
22 (allBenchmarks)
23where
25import System.IO (Handle)
26import Prelude hiding (last, length)
27import Streamly.Internal.Data.Array.Foreign.Types (defaultChunkSize)
29import qualified Streamly.FileSystem.Handle as FH
30import qualified Streamly.Internal.Data.Unfold as IUF
31import qualified Streamly.Internal.FileSystem.Handle as IFH
32import qualified Streamly.Internal.Data.Array.Stream.Foreign as AS
33import qualified Streamly.Data.Array.Foreign as A
34import qualified Streamly.Prelude as S
36import Gauge hiding (env)
37import Streamly.Benchmark.Common.Handle
39#ifdef INSPECTION
40import Foreign.Storable (Storable)
41import Streamly.Internal.Data.Stream.StreamD.Type (Step(..))
43import qualified Streamly.Internal.Data.Stream.StreamD.Type as D
44import qualified Streamly.Internal.Data.Tuple.Strict as Strict
45import qualified Streamly.Internal.Data.Array.Stream.Mut.Foreign as MAS
46import qualified Streamly.Internal.Data.Array.Foreign.Types as AT
47import qualified Streamly.Internal.Data.Array.Foreign.Mut.Types as MA
49import Test.Inspection
50#endif
52-------------------------------------------------------------------------------
53-- copy chunked
54-------------------------------------------------------------------------------
56-- | Copy file
57copyChunks :: Handle -> Handle -> IO ()
58copyChunks inh outh = S.fold (IFH.writeChunks outh) $ IFH.toChunks inh
60#ifdef INSPECTION
61inspect $ hasNoTypeClasses 'copyChunks
62inspect $ 'copyChunks `hasNoType` ''Step
63#endif
65o_1_space_copy_chunked :: BenchEnv -> [Benchmark]
66o_1_space_copy_chunked env =
67 [ bgroup "copy/toChunks"
68 [ mkBench "toNull" env $ \inH _ ->
69 copyChunks inH (nullH env)
70 , mkBench "raw" env $ \inH outH ->
71 copyChunks inH outH
72 ]
73 ]
75-------------------------------------------------------------------------------
76-- copy unfold
77-------------------------------------------------------------------------------
79-- | Copy file
80copyStream :: Handle -> Handle -> IO ()
81copyStream inh outh = S.fold (FH.write outh) (S.unfold FH.read inh)
83#ifdef INSPECTION
84inspect $ hasNoTypeClasses 'copyStream
85inspect $ 'copyStream `hasNoType` ''Step -- S.unfold
86inspect $ 'copyStream `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
87inspect $ 'copyStream `hasNoType` ''MA.ReadUState -- FH.read/A.read
88inspect $ 'copyStream `hasNoType` ''AT.ArrayUnsafe -- FH.write/writeNUnsafe
89inspect $ 'copyStream `hasNoType` ''Strict.Tuple3' -- FH.write/chunksOf
90#endif
92o_1_space_copy_read :: BenchEnv -> [Benchmark]
93o_1_space_copy_read env =
94 [ bgroup "copy/read"
95 [ mkBench "rawToNull" env $ \inh _ ->
96 copyStream inh (nullH env)
97 , mkBench "rawToFile" env $ \inh outh ->
98 copyStream inh outh
99 ]
100 ]
102-------------------------------------------------------------------------------
103-- copy stream
104-------------------------------------------------------------------------------
106-- | Send the file contents to /dev/null
107readFromBytesNull :: Handle -> Handle -> IO ()
108readFromBytesNull inh devNull = IFH.fromBytes devNull $ S.unfold FH.read inh
110#ifdef INSPECTION
111inspect $ hasNoTypeClasses 'readFromBytesNull
112inspect $ 'readFromBytesNull `hasNoType` ''Step
113inspect $ 'readFromBytesNull `hasNoType` ''MAS.SpliceState
114inspect $ 'readFromBytesNull `hasNoType` ''AT.ArrayUnsafe -- FH.fromBytes/S.arraysOf
115inspect $ 'readFromBytesNull `hasNoType` ''D.FoldMany1
116#endif
118-- | Send the file contents ('defaultChunkSize') to /dev/null
119readWithBufferOfFromBytesNull :: Handle -> Handle -> IO ()
120readWithBufferOfFromBytesNull inh devNull =
121 IFH.fromBytes devNull
122 $ S.unfold FH.readWithBufferOf (defaultChunkSize, inh)
124#ifdef INSPECTION
125inspect $ hasNoTypeClasses 'readWithBufferOfFromBytesNull
126inspect $ 'readWithBufferOfFromBytesNull `hasNoType` ''Step
127inspect $ 'readWithBufferOfFromBytesNull `hasNoType` ''MAS.SpliceState
128inspect $ 'readWithBufferOfFromBytesNull `hasNoType` ''AT.ArrayUnsafe -- FH.fromBytes/S.arraysOf
129inspect $ 'readWithBufferOfFromBytesNull `hasNoType` ''D.FoldMany1
130#endif
132-- | Send the chunk content ('defaultChunkSize') to /dev/null
133-- Implicitly benchmarked via 'readFromBytesNull'
134_readChunks :: Handle -> Handle -> IO ()
135_readChunks inh devNull = IUF.fold unf fld inh
137 where
139 fld = FH.write devNull
140 unf = IUF.concat FH.readChunks A.read
142-- | Send the chunk content to /dev/null
143-- Implicitly benchmarked via 'readWithBufferOfFromBytesNull'
144_readChunksWithBufferOf :: Handle -> Handle -> IO ()
145_readChunksWithBufferOf inh devNull = IUF.fold unf fld (defaultChunkSize, inh)
147 where
149 fld = FH.write devNull
150 unf = IUF.concat FH.readChunksWithBufferOf A.read
153o_1_space_copy_fromBytes :: BenchEnv -> [Benchmark]
154o_1_space_copy_fromBytes env =
155 [ bgroup "copy/fromBytes"
156 [ mkBench "rawToNull" env $ \inh _ ->
157 readFromBytesNull inh (nullH env)
158 , mkBench "FH.readWithBufferOf" env $ \inh _ ->
159 readWithBufferOfFromBytesNull inh (nullH env)
160 ]
161 ]
163-- | Send the file contents ('defaultChunkSize') to /dev/null
164{-# NOINLINE writeReadWithBufferOf #-}
165writeReadWithBufferOf :: Handle -> Handle -> IO ()
166writeReadWithBufferOf inh devNull = IUF.fold unf fld (defaultChunkSize, inh)
168 where
170 fld = FH.writeWithBufferOf defaultChunkSize devNull
171 unf = FH.readWithBufferOf
173#ifdef INSPECTION
174inspect $ hasNoTypeClasses 'writeReadWithBufferOf
175inspect $ 'writeReadWithBufferOf `hasNoType` ''Step
176inspect $ 'writeReadWithBufferOf `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
177inspect $ 'writeReadWithBufferOf `hasNoType` ''MA.ReadUState -- FH.read/A.read
178inspect $ 'writeReadWithBufferOf `hasNoType` ''AT.ArrayUnsafe -- FH.write/writeNUnsafe
179#endif
181-- | Send the file contents ('AT.defaultChunkSize') to /dev/null
182{-# NOINLINE writeRead #-}
183writeRead :: Handle -> Handle -> IO ()
184writeRead inh devNull = IUF.fold unf fld inh
186 where
188 fld = FH.write devNull
189 unf = FH.read
191#ifdef INSPECTION
192inspect $ hasNoTypeClasses 'writeRead
193inspect $ 'writeRead `hasNoType` ''Step
194inspect $ 'writeRead `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
195inspect $ 'writeRead `hasNoType` ''MA.ReadUState -- FH.read/A.read
196inspect $ 'writeRead `hasNoType` ''AT.ArrayUnsafe -- FH.write/writeNUnsafe
197#endif
199o_1_space_copy :: BenchEnv -> [Benchmark]
200o_1_space_copy env =
201 [ bgroup "copy"
202 [ mkBench "FH.write . FH.read" env $ \inh _ ->
203 writeRead inh (nullH env)
204 , mkBench "FH.writeWithBufferOf . FH.readWithBufferOf" env $ \inh _ ->
205 writeReadWithBufferOf inh (nullH env)
206 ]
207 ]
209-------------------------------------------------------------------------------
210-- copy with group/ungroup transformations
211-------------------------------------------------------------------------------
213-- | Lines and unlines
214copyChunksSplitInterposeSuffix :: Handle -> Handle -> IO ()
215copyChunksSplitInterposeSuffix inh outh =
216 S.fold (IFH.write outh)
217 $ AS.interposeSuffix 10
218 $ AS.splitOnSuffix 10
219 $ IFH.toChunks inh
221#ifdef INSPECTION
222inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterposeSuffix [''Storable]
223inspect $ 'copyChunksSplitInterposeSuffix `hasNoType` ''Step
224#endif
226-- | Words and unwords
227copyChunksSplitInterpose :: Handle -> Handle -> IO ()
228copyChunksSplitInterpose inh outh =
229 S.fold (IFH.write outh)
230 $ AS.interpose 32
231 -- XXX this is not correct word splitting combinator
232 $ AS.splitOn 32
233 $ IFH.toChunks inh
235#ifdef INSPECTION
236inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterpose [''Storable]
237inspect $ 'copyChunksSplitInterpose `hasNoType` ''Step
238#endif
240o_1_space_copy_toChunks_group_ungroup :: BenchEnv -> [Benchmark]
241o_1_space_copy_toChunks_group_ungroup env =
242 [ bgroup "copy/toChunks/group-ungroup"
243 [ mkBench "AS.interposeSuffix . AS.splitOnSuffix" env $ \inh outh ->
244 copyChunksSplitInterposeSuffix inh outh
245 , mkBenchSmall "AS.interpose . AS.splitOn" env $ \inh outh ->
246 copyChunksSplitInterpose inh outh
247 ]
248 ]
251-------------------------------------------------------------------------------
252--
253-------------------------------------------------------------------------------
255allBenchmarks :: BenchEnv -> [Benchmark]
256allBenchmarks env = Prelude.concat
257 [ o_1_space_copy_chunked env
258 , o_1_space_copy_read env
259 , o_1_space_copy_fromBytes env
260 , o_1_space_copy env
261 , o_1_space_copy_toChunks_group_ungroup env
262 ]