on 401f504 help sign in
261 lines 8.8 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.Storable.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.Memory.ArrayStream as AS
33import qualified Streamly.Data.Array.Storable.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.Storable.Foreign as A
46import qualified Streamly.Internal.Data.Array.Storable.Foreign.Types as AT
48import Test.Inspection
49#endif
51-------------------------------------------------------------------------------
52-- copy chunked
53-------------------------------------------------------------------------------
55-- | Copy file
56copyChunks :: Handle -> Handle -> IO ()
57copyChunks inh outh = S.fold (IFH.writeChunks outh) $ IFH.toChunks inh
59#ifdef INSPECTION
60inspect $ hasNoTypeClasses 'copyChunks
61inspect $ 'copyChunks `hasNoType` ''Step
62#endif
64o_1_space_copy_chunked :: BenchEnv -> [Benchmark]
65o_1_space_copy_chunked env =
66 [ bgroup "copy/toChunks"
67 [ mkBench "toNull" env $ \inH _ ->
68 copyChunks inH (nullH env)
69 , mkBench "raw" env $ \inH outH ->
70 copyChunks inH outH
71 ]
72 ]
74-------------------------------------------------------------------------------
75-- copy unfold
76-------------------------------------------------------------------------------
78-- | Copy file
79copyStream :: Handle -> Handle -> IO ()
80copyStream inh outh = S.fold (FH.write outh) (S.unfold FH.read inh)
82#ifdef INSPECTION
83inspect $ hasNoTypeClasses 'copyStream
84inspect $ 'copyStream `hasNoType` ''Step -- S.unfold
85inspect $ 'copyStream `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
86inspect $ 'copyStream `hasNoType` ''A.ReadUState -- FH.read/A.read
87inspect $ 'copyStream `hasNoType` ''AT.ArrayUnsafe -- FH.write/writeNUnsafe
88inspect $ 'copyStream `hasNoType` ''Strict.Tuple3' -- FH.write/chunksOf
89#endif
91o_1_space_copy_read :: BenchEnv -> [Benchmark]
92o_1_space_copy_read env =
93 [ bgroup "copy/read"
94 [ mkBench "rawToNull" env $ \inh _ ->
95 copyStream inh (nullH env)
96 , mkBench "rawToFile" env $ \inh outh ->
97 copyStream inh outh
98 ]
99 ]
101-------------------------------------------------------------------------------
102-- copy stream
103-------------------------------------------------------------------------------
105-- | Send the file contents to /dev/null
106readFromBytesNull :: Handle -> Handle -> IO ()
107readFromBytesNull inh devNull = IFH.fromBytes devNull $ S.unfold FH.read inh
109#ifdef INSPECTION
110inspect $ hasNoTypeClasses 'readFromBytesNull
111inspect $ 'readFromBytesNull `hasNoType` ''Step
112inspect $ 'readFromBytesNull `hasNoType` ''AT.SpliceState
113inspect $ 'readFromBytesNull `hasNoType` ''AT.ArrayUnsafe -- FH.fromBytes/S.arraysOf
114inspect $ 'readFromBytesNull `hasNoType` ''D.GroupState
115#endif
117-- | Send the file contents ('defaultChunkSize') to /dev/null
118readWithBufferOfFromBytesNull :: Handle -> Handle -> IO ()
119readWithBufferOfFromBytesNull inh devNull =
120 IFH.fromBytes devNull
121 $ S.unfold FH.readWithBufferOf (defaultChunkSize, inh)
123#ifdef INSPECTION
124inspect $ hasNoTypeClasses 'readWithBufferOfFromBytesNull
125inspect $ 'readWithBufferOfFromBytesNull `hasNoType` ''Step
126inspect $ 'readWithBufferOfFromBytesNull `hasNoType` ''AT.SpliceState
127inspect $ 'readWithBufferOfFromBytesNull `hasNoType` ''AT.ArrayUnsafe -- FH.fromBytes/S.arraysOf
128inspect $ 'readWithBufferOfFromBytesNull `hasNoType` ''D.GroupState
129#endif
131-- | Send the chunk content ('defaultChunkSize') to /dev/null
132-- Implicitly benchmarked via 'readFromBytesNull'
133_readChunks :: Handle -> Handle -> IO ()
134_readChunks inh devNull = IUF.fold unf fld inh
136 where
138 fld = FH.write devNull
139 unf = IUF.concat FH.readChunks A.read
141-- | Send the chunk content to /dev/null
142-- Implicitly benchmarked via 'readWithBufferOfFromBytesNull'
143_readChunksWithBufferOf :: Handle -> Handle -> IO ()
144_readChunksWithBufferOf inh devNull = IUF.fold unf fld (defaultChunkSize, inh)
146 where
148 fld = FH.write devNull
149 unf = IUF.concat FH.readChunksWithBufferOf A.read
152o_1_space_copy_fromBytes :: BenchEnv -> [Benchmark]
153o_1_space_copy_fromBytes env =
154 [ bgroup "copy/fromBytes"
155 [ mkBench "rawToNull" env $ \inh _ ->
156 readFromBytesNull inh (nullH env)
157 , mkBench "FH.readWithBufferOf" env $ \inh _ ->
158 readWithBufferOfFromBytesNull inh (nullH env)
159 ]
160 ]
162-- | Send the file contents ('defaultChunkSize') to /dev/null
163{-# NOINLINE writeReadWithBufferOf #-}
164writeReadWithBufferOf :: Handle -> Handle -> IO ()
165writeReadWithBufferOf inh devNull = IUF.fold unf fld (defaultChunkSize, inh)
167 where
169 fld = FH.writeWithBufferOf defaultChunkSize devNull
170 unf = FH.readWithBufferOf
172#ifdef INSPECTION
173inspect $ hasNoTypeClasses 'writeReadWithBufferOf
174inspect $ 'writeReadWithBufferOf `hasNoType` ''Step
175inspect $ 'writeReadWithBufferOf `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
176inspect $ 'writeReadWithBufferOf `hasNoType` ''A.ReadUState -- FH.read/A.read
177inspect $ 'writeReadWithBufferOf `hasNoType` ''AT.ArrayUnsafe -- FH.write/writeNUnsafe
178#endif
180-- | Send the file contents ('AT.defaultChunkSize') to /dev/null
181{-# NOINLINE writeRead #-}
182writeRead :: Handle -> Handle -> IO ()
183writeRead inh devNull = IUF.fold unf fld inh
185 where
187 fld = FH.write devNull
188 unf = FH.read
190#ifdef INSPECTION
191inspect $ hasNoTypeClasses 'writeRead
192inspect $ 'writeRead `hasNoType` ''Step
193inspect $ 'writeRead `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
194inspect $ 'writeRead `hasNoType` ''A.ReadUState -- FH.read/A.read
195inspect $ 'writeRead `hasNoType` ''AT.ArrayUnsafe -- FH.write/writeNUnsafe
196#endif
198o_1_space_copy :: BenchEnv -> [Benchmark]
199o_1_space_copy env =
200 [ bgroup "copy"
201 [ mkBench "FH.write . FH.read" env $ \inh _ ->
202 writeRead inh (nullH env)
203 , mkBench "FH.writeWithBufferOf . FH.readWithBufferOf" env $ \inh _ ->
204 writeReadWithBufferOf inh (nullH env)
205 ]
206 ]
208-------------------------------------------------------------------------------
209-- copy with group/ungroup transformations
210-------------------------------------------------------------------------------
212-- | Lines and unlines
213copyChunksSplitInterposeSuffix :: Handle -> Handle -> IO ()
214copyChunksSplitInterposeSuffix inh outh =
215 S.fold (IFH.write outh)
216 $ AS.interposeSuffix 10
217 $ AS.splitOnSuffix 10
218 $ IFH.toChunks inh
220#ifdef INSPECTION
221inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterposeSuffix [''Storable]
222inspect $ 'copyChunksSplitInterposeSuffix `hasNoType` ''Step
223#endif
225-- | Words and unwords
226copyChunksSplitInterpose :: Handle -> Handle -> IO ()
227copyChunksSplitInterpose inh outh =
228 S.fold (IFH.write outh)
229 $ AS.interpose 32
230 -- XXX this is not correct word splitting combinator
231 $ AS.splitOn 32
232 $ IFH.toChunks inh
234#ifdef INSPECTION
235inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterpose [''Storable]
236inspect $ 'copyChunksSplitInterpose `hasNoType` ''Step
237#endif
239o_1_space_copy_toChunks_group_ungroup :: BenchEnv -> [Benchmark]
240o_1_space_copy_toChunks_group_ungroup env =
241 [ bgroup "copy/toChunks/group-ungroup"
242 [ mkBench "AS.interposeSuffix . AS.splitOnSuffix" env $ \inh outh ->
243 copyChunksSplitInterposeSuffix inh outh
244 , mkBenchSmall "AS.interpose . AS.splitOn" env $ \inh outh ->
245 copyChunksSplitInterpose inh outh
246 ]
247 ]
250-------------------------------------------------------------------------------
251--
252-------------------------------------------------------------------------------
254allBenchmarks :: BenchEnv -> [Benchmark]
255allBenchmarks env = Prelude.concat
256 [ o_1_space_copy_chunked env
257 , o_1_space_copy_read env
258 , o_1_space_copy_fromBytes env
259 , o_1_space_copy env
260 , o_1_space_copy_toChunks_group_ungroup env
261 ]