git.iko.soy/streamly
on fe28607 help sign in
streamly/benchmark/Streamly/Benchmark/Data/Stream/Exceptions.hs
353 lines 12 kB history raw
1-- |
2-- Module : Stream.Exceptions
3-- Copyright : (c) 2019 Composewell Technologies
4-- License : BSD-3-Clause
5-- Maintainer : streamly@composewell.com
6-- Stability : experimental
7-- Portability : GHC
9{-# LANGUAGE CPP #-}
10{-# LANGUAGE FlexibleContexts #-}
11{-# LANGUAGE ScopedTypeVariables #-}
13#ifdef USE_PRELUDE
14{-# OPTIONS_GHC -Wno-deprecations #-}
15#endif
17#ifdef __HADDOCK_VERSION__
18#undef INSPECTION
19#endif
21#ifdef INSPECTION
22{-# LANGUAGE TemplateHaskell #-}
23{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
24#endif
26module Stream.Exceptions (benchmarks) where
28import Control.Exception (Exception, throwIO)
29import Stream.Common (drain)
30import Streamly.Internal.Data.Stream (Stream)
32import qualified Data.IORef as Ref
33import qualified Data.Map.Strict as Map
34import qualified Stream.Common as Common
36#ifndef USE_STREAMLY_CORE
37import Control.Exception (SomeException)
38import System.IO (Handle, hClose, hPutChar)
39import qualified Streamly.FileSystem.Handle as FH
40import qualified Streamly.Internal.FileSystem.Handle as IFH
41import qualified Streamly.Internal.Data.Unfold as IUF
42import qualified Streamly.Internal.Data.Unfold.Exception as IUF
43#endif
45#ifdef USE_PRELUDE
46import qualified Streamly.Internal.Data.Stream.IsStream as Stream
47#else
48import qualified Streamly.Internal.Data.Stream as Stream
49import qualified Streamly.Internal.Data.Stream.Exception.Lifted as Stream
50#endif
52import Gauge hiding (env)
53import Prelude hiding (last, length)
54import Streamly.Benchmark.Common
55import Streamly.Benchmark.Common.Handle
57#ifdef INSPECTION
58import Test.Inspection
60import qualified Streamly.Internal.Data.Stream.StreamD as D
61#endif
63-------------------------------------------------------------------------------
64-- stream exceptions
65-------------------------------------------------------------------------------
67{-# INLINE replicateM #-}
68replicateM :: Common.MonadAsync m => Int -> m a -> Stream m a
69#ifdef USE_PRELUDE
70replicateM = Stream.replicateM
71#else
72replicateM n = Stream.sequence . Stream.replicate n
73#endif
75data BenchException
76 = BenchException1
77 | BenchException2
78 deriving (Show, Eq, Ord)
80instance Exception BenchException
82retryNoneSimple :: Int -> Int -> IO ()
83retryNoneSimple length from =
84 drain
85 $ Stream.retry
86 (Map.singleton BenchException1 length)
87 (const Stream.nil)
88 source
90 where
92 source = Stream.enumerateFromTo from (from + length)
94retryNone :: Int -> Int -> IO ()
95retryNone length from = do
96 ref <- Ref.newIORef (0 :: Int)
97 drain
98 $ Stream.retry (Map.singleton BenchException1 length) (const Stream.nil)
99 $ source ref
101 where
103 source ref =
104 replicateM (from + length)
105 $ Ref.modifyIORef' ref (+ 1) >> Ref.readIORef ref
107retryAll :: Int -> Int -> IO ()
108retryAll length from = do
109 ref <- Ref.newIORef 0
110 drain
111 $ Stream.retry
112 (Map.singleton BenchException1 (length + from)) (const Stream.nil)
113 $ source ref
115 where
117 source ref =
118 Stream.fromEffect
119 $ do
120 Ref.modifyIORef' ref (+ 1)
121 val <- Ref.readIORef ref
122 if val >= length
123 then return length
124 else throwIO BenchException1
126retryUnknown :: Int -> Int -> IO ()
127retryUnknown length from = do
128 drain
129 $ Stream.retry (Map.singleton BenchException1 length) (const source)
130 $ throwIO BenchException2 `Stream.before` Stream.nil
132 where
134 source = Stream.enumerateFromTo from (from + length)
137o_1_space_serial_exceptions :: Int -> [Benchmark]
138o_1_space_serial_exceptions length =
139 [ bgroup
140 "exceptions/serial"
141 [ benchIOSrc1 "retryNoneSimple" (retryNoneSimple length)
142 , benchIOSrc1 "retryNone" (retryNone length)
143 , benchIOSrc1 "retryAll" (retryAll length)
144 , benchIOSrc1 "retryUnknown" (retryUnknown length)
145 ]
146 ]
148-- XXX Move these to FileSystem.Handle benchmarks
149#ifndef USE_STREAMLY_CORE
151-------------------------------------------------------------------------------
152-- copy stream exceptions
153-------------------------------------------------------------------------------
155-- | Send the file contents to /dev/null with exception handling
156readWriteOnExceptionStream :: Handle -> Handle -> IO ()
157readWriteOnExceptionStream inh devNull =
158 let readEx = Stream.onException (hClose inh) (Stream.unfold FH.reader inh)
159 in Stream.fold (FH.write devNull) readEx
161#ifdef INSPECTION
162inspect $ hasNoTypeClasses 'readWriteOnExceptionStream
163#endif
165-- | Send the file contents to /dev/null with exception handling
166readWriteHandleExceptionStream :: Handle -> Handle -> IO ()
167readWriteHandleExceptionStream inh devNull =
168 let handler (_e :: SomeException) = Stream.fromEffect (hClose inh >> return 10)
169 readEx = Stream.handle handler (Stream.unfold FH.reader inh)
170 in Stream.fold (FH.write devNull) readEx
172#ifdef INSPECTION
173inspect $ hasNoTypeClasses 'readWriteHandleExceptionStream
174#endif
176-- | Send the file contents to /dev/null with exception handling
177readWriteFinally_Stream :: Handle -> Handle -> IO ()
178readWriteFinally_Stream inh devNull =
179 let readEx =
180 Stream.finallyUnsafe (hClose inh) (Stream.unfold FH.reader inh)
181 in Stream.fold (FH.write devNull) readEx
183#ifdef INSPECTION
184inspect $ hasNoTypeClasses 'readWriteFinally_Stream
185#endif
187readWriteFinallyStream :: Handle -> Handle -> IO ()
188readWriteFinallyStream inh devNull =
189 let readEx = Stream.finally (hClose inh) (Stream.unfold FH.reader inh)
190 in Stream.fold (FH.write devNull) readEx
192-- | Send the file contents to /dev/null with exception handling
193fromToBytesBracket_Stream :: Handle -> Handle -> IO ()
194fromToBytesBracket_Stream inh devNull =
195 let readEx = Stream.bracketUnsafe (return ()) (\_ -> hClose inh)
196 (\_ -> IFH.read inh)
197 in IFH.putBytes devNull readEx
199#ifdef INSPECTION
200inspect $ hasNoTypeClasses 'fromToBytesBracket_Stream
201#endif
203fromToBytesBracketStream :: Handle -> Handle -> IO ()
204fromToBytesBracketStream inh devNull =
205 let readEx = Stream.bracket (return ()) (\_ -> hClose inh)
206 (\_ -> IFH.read inh)
207 in IFH.putBytes devNull readEx
209readWriteBeforeAfterStream :: Handle -> Handle -> IO ()
210readWriteBeforeAfterStream inh devNull =
211 let readEx =
212 Stream.after (hClose inh)
213 $ Stream.before (hPutChar devNull 'A') (Stream.unfold FH.reader inh)
214 in Stream.fold (FH.write devNull) readEx
216#ifdef INSPECTION
217inspect $ 'readWriteBeforeAfterStream `hasNoType` ''D.Step
218#endif
220readWriteAfterStream :: Handle -> Handle -> IO ()
221readWriteAfterStream inh devNull =
222 let readEx = Stream.after (hClose inh) (Stream.unfold FH.reader inh)
223 in Stream.fold (FH.write devNull) readEx
225#ifdef INSPECTION
226inspect $ 'readWriteAfterStream `hasNoType` ''D.Step
227#endif
229readWriteAfter_Stream :: Handle -> Handle -> IO ()
230readWriteAfter_Stream inh devNull =
231 let readEx = Stream.afterUnsafe (hClose inh) (Stream.unfold FH.reader inh)
232 in Stream.fold (FH.write devNull) readEx
234#ifdef INSPECTION
235inspect $ hasNoTypeClasses 'readWriteAfter_Stream
236inspect $ 'readWriteAfter_Stream `hasNoType` ''D.Step
237#endif
239o_1_space_copy_stream_exceptions :: BenchEnv -> [Benchmark]
240o_1_space_copy_stream_exceptions env =
241 [ bgroup "exceptions"
242 [ mkBenchSmall "Stream.onException" env $ \inh _ ->
243 readWriteOnExceptionStream inh (nullH env)
244 , mkBenchSmall "Stream.handle" env $ \inh _ ->
245 readWriteHandleExceptionStream inh (nullH env)
246 , mkBenchSmall "Stream.finally_" env $ \inh _ ->
247 readWriteFinally_Stream inh (nullH env)
248 , mkBenchSmall "Stream.finally" env $ \inh _ ->
249 readWriteFinallyStream inh (nullH env)
250 , mkBenchSmall "Stream.after . Stream.before" env $ \inh _ ->
251 readWriteBeforeAfterStream inh (nullH env)
252 , mkBenchSmall "Stream.after" env $ \inh _ ->
253 readWriteAfterStream inh (nullH env)
254 , mkBenchSmall "Stream.after_" env $ \inh _ ->
255 readWriteAfter_Stream inh (nullH env)
256 ]
257 , bgroup "exceptions/fromToBytes"
258 [ mkBenchSmall "Stream.bracket_" env $ \inh _ ->
259 fromToBytesBracket_Stream inh (nullH env)
260 , mkBenchSmall "Stream.bracket" env $ \inh _ ->
261 fromToBytesBracketStream inh (nullH env)
262 ]
263 ]
265 -------------------------------------------------------------------------------
266-- Exceptions readChunks
267-------------------------------------------------------------------------------
269-- | Send the file contents to /dev/null with exception handling
270readChunksOnException :: Handle -> Handle -> IO ()
271readChunksOnException inh devNull =
272 let readEx = IUF.onException (\_ -> hClose inh) FH.chunkReader
273 in IUF.fold (IFH.writeChunks devNull) readEx inh
275#ifdef INSPECTION
276inspect $ hasNoTypeClasses 'readChunksOnException
277#endif
279-- | Send the file contents to /dev/null with exception handling
280readChunksBracket_ :: Handle -> Handle -> IO ()
281readChunksBracket_ inh devNull =
282 let readEx = IUF.bracket_ return (\_ -> hClose inh) FH.chunkReader
283 in IUF.fold (IFH.writeChunks devNull) readEx inh
285#ifdef INSPECTION
286inspect $ hasNoTypeClasses 'readChunksBracket_
287#endif
289readChunksBracket :: Handle -> Handle -> IO ()
290readChunksBracket inh devNull =
291 let readEx = IUF.bracket return (\_ -> hClose inh) FH.chunkReader
292 in IUF.fold (IFH.writeChunks devNull) readEx inh
294o_1_space_copy_exceptions_readChunks :: BenchEnv -> [Benchmark]
295o_1_space_copy_exceptions_readChunks env =
296 [ bgroup "exceptions/readChunks"
297 [ mkBench "UF.onException" env $ \inH _ ->
298 readChunksOnException inH (nullH env)
299 , mkBench "UF.bracket_" env $ \inH _ ->
300 readChunksBracket_ inH (nullH env)
301 , mkBench "UF.bracket" env $ \inH _ ->
302 readChunksBracket inH (nullH env)
303 ]
304 ]
306-------------------------------------------------------------------------------
307-- Exceptions toChunks
308-------------------------------------------------------------------------------
310-- | Send the file contents to /dev/null with exception handling
311toChunksBracket_ :: Handle -> Handle -> IO ()
312toChunksBracket_ inh devNull =
313 let readEx = Stream.bracketUnsafe
314 (return ())
315 (\_ -> hClose inh)
316 (\_ -> IFH.readChunks inh)
317 in Stream.fold (IFH.writeChunks devNull) readEx
319#ifdef INSPECTION
320inspect $ hasNoTypeClasses 'toChunksBracket_
321#endif
323toChunksBracket :: Handle -> Handle -> IO ()
324toChunksBracket inh devNull =
325 let readEx = Stream.bracket
326 (return ())
327 (\_ -> hClose inh)
328 (\_ -> IFH.readChunks inh)
329 in Stream.fold (IFH.writeChunks devNull) readEx
331o_1_space_copy_exceptions_toChunks :: BenchEnv -> [Benchmark]
332o_1_space_copy_exceptions_toChunks env =
333 [ bgroup "exceptions/toChunks"
334 [ mkBench "Stream.bracket_" env $ \inH _ ->
335 toChunksBracket_ inH (nullH env)
336 , mkBench "Stream.bracket" env $ \inH _ ->
337 toChunksBracket inH (nullH env)
338 ]
339 ]
341#endif
343benchmarks :: String -> BenchEnv -> Int -> [Benchmark]
344benchmarks moduleName _env size =
345 [ bgroup (o_1_space_prefix moduleName) $ concat
346 [ o_1_space_serial_exceptions size
347#ifndef USE_STREAMLY_CORE
348 , o_1_space_copy_exceptions_readChunks _env
349 , o_1_space_copy_exceptions_toChunks _env
350 , o_1_space_copy_stream_exceptions _env
351#endif
352 ]
353 ]