git.iko.soy/streamly
on a819eb7 help sign in
streamly/benchmark/Streamly/Benchmark/Data/Stream/Exceptions.hs
362 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)
31import qualified Data.IORef as Ref
32import qualified Data.Map.Strict as Map
34import Control.Exception (SomeException)
35import System.IO (Handle, hClose, hPutChar)
36import qualified Streamly.FileSystem.Handle as FH
37import qualified Streamly.Internal.FileSystem.Handle as IFH
38import qualified Streamly.Internal.Data.Unfold as IUF
39import qualified Streamly.Internal.Data.Unfold.Exception as IUF
41#ifdef USE_PRELUDE
42import qualified Streamly.Internal.Data.Stream.IsStream as Stream
43#else
44import qualified Streamly.Internal.Data.Stream as Stream
45import qualified Streamly.Internal.Data.Stream.Exception.Lifted as Stream
46#endif
48import Gauge hiding (env)
49import Prelude hiding (last, length)
50import Streamly.Benchmark.Common
51import Streamly.Benchmark.Common.Handle
53#ifdef INSPECTION
54import Test.Inspection
56import qualified Streamly.Internal.Data.Stream as D
57#endif
59#ifdef USE_PRELUDE
60type Stream = Stream.SerialT
61toStreamD = Stream.toStream
62fromStreamD = Stream.fromStream
63#else
64type Stream = Stream.Stream
65toStreamD :: a -> a
66toStreamD = id
67fromStreamD :: a -> a
68fromStreamD = id
69#endif
71afterUnsafe :: IO b -> Stream IO a -> Stream IO a
72finallyUnsafe :: IO b -> Stream IO a -> Stream IO a
73bracketUnsafe :: IO b -> (b -> IO c) -> (b -> Stream IO a) -> Stream IO a
74#ifdef USE_PRELUDE
75afterUnsafe = Stream.after_
76finallyUnsafe = Stream.finally_
77bracketUnsafe = Stream.bracket_
78#else
79afterUnsafe = Stream.afterUnsafe
80finallyUnsafe = Stream.finallyUnsafe
81bracketUnsafe = Stream.bracketUnsafe
82#endif
84-------------------------------------------------------------------------------
85-- stream exceptions
86-------------------------------------------------------------------------------
88data BenchException
89 = BenchException1
90 | BenchException2
91 deriving (Show, Eq, Ord)
93instance Exception BenchException
95retryNoneSimple :: Int -> Int -> IO ()
96retryNoneSimple length from =
97 drain
98 $ Stream.retry
99 (Map.singleton BenchException1 length)
100 (const Stream.nil)
101 source
103 where
105 source = Stream.enumerateFromTo from (from + length)
107retryNone :: Int -> Int -> IO ()
108retryNone length from = do
109 ref <- Ref.newIORef (0 :: Int)
110 drain
111 $ Stream.retry (Map.singleton BenchException1 length) (const Stream.nil)
112 $ source ref
114 where
116 source ref =
117 Stream.replicateM (from + length)
118 $ Ref.modifyIORef' ref (+ 1) >> Ref.readIORef ref
120retryAll :: Int -> Int -> IO ()
121retryAll length from = do
122 ref <- Ref.newIORef 0
123 drain
124 $ Stream.retry
125 (Map.singleton BenchException1 (length + from)) (const Stream.nil)
126 $ source ref
128 where
130 source ref =
131 Stream.fromEffect
132 $ do
133 Ref.modifyIORef' ref (+ 1)
134 val <- Ref.readIORef ref
135 if val >= length
136 then return length
137 else throwIO BenchException1
139retryUnknown :: Int -> Int -> IO ()
140retryUnknown length from = do
141 drain
142 $ Stream.retry (Map.singleton BenchException1 length) (const source)
143 $ throwIO BenchException2 `Stream.before` Stream.nil
145 where
147 source = Stream.enumerateFromTo from (from + length)
150o_1_space_serial_exceptions :: Int -> [Benchmark]
151o_1_space_serial_exceptions length =
152 [ bgroup
153 "exceptions/serial"
154 [ benchIOSrc1 "retryNoneSimple" (retryNoneSimple length)
155 , benchIOSrc1 "retryNone" (retryNone length)
156 , benchIOSrc1 "retryAll" (retryAll length)
157 , benchIOSrc1 "retryUnknown" (retryUnknown length)
158 ]
159 ]
161-- XXX Move these to FileSystem.Handle benchmarks
163-------------------------------------------------------------------------------
164-- copy stream exceptions
165-------------------------------------------------------------------------------
167-- | Send the file contents to /dev/null with exception handling
168readWriteOnExceptionStream :: Handle -> Handle -> IO ()
169readWriteOnExceptionStream inh devNull =
170 let readEx = Stream.onException (hClose inh) (Stream.unfold FH.reader inh)
171 in Stream.fold (FH.write devNull) readEx
173#ifdef INSPECTION
174inspect $ hasNoTypeClasses 'readWriteOnExceptionStream
175#endif
177-- | Send the file contents to /dev/null with exception handling
178readWriteHandleExceptionStream :: Handle -> Handle -> IO ()
179readWriteHandleExceptionStream inh devNull =
180 let handler (_e :: SomeException) =
181 return $ Stream.fromEffect (hClose inh >> return 10)
182 readEx = Stream.handle handler (Stream.unfold FH.reader inh)
183 in Stream.fold (FH.write devNull) readEx
185#ifdef INSPECTION
186inspect $ hasNoTypeClasses 'readWriteHandleExceptionStream
187#endif
189-- | Send the file contents to /dev/null with exception handling
190readWriteFinally_Stream :: Handle -> Handle -> IO ()
191readWriteFinally_Stream inh devNull =
192 let readEx =
193 finallyUnsafe (hClose inh) (Stream.unfold FH.reader inh)
194 in Stream.fold (FH.write devNull) readEx
196#ifdef INSPECTION
197inspect $ hasNoTypeClasses 'readWriteFinally_Stream
198#endif
200readWriteFinallyStream :: Handle -> Handle -> IO ()
201readWriteFinallyStream inh devNull =
202 let readEx = Stream.finally (hClose inh) (Stream.unfold FH.reader inh)
203 in Stream.fold (FH.write devNull) readEx
205-- | Send the file contents to /dev/null with exception handling
206fromToBytesBracket_Stream :: Handle -> Handle -> IO ()
207fromToBytesBracket_Stream inh devNull =
208 let readEx = bracketUnsafe (return ()) (\_ -> hClose inh)
209 (\_ -> fromStreamD $ IFH.read inh)
210 in IFH.putBytes devNull (toStreamD readEx)
212#ifdef INSPECTION
213inspect $ hasNoTypeClasses 'fromToBytesBracket_Stream
214#endif
216fromToBytesBracketStream :: Handle -> Handle -> IO ()
217fromToBytesBracketStream inh devNull =
218 let readEx = Stream.bracket (return ()) (\_ -> hClose inh)
219 (\_ -> fromStreamD $ IFH.read inh)
220 in IFH.putBytes devNull (toStreamD readEx)
222readWriteBeforeAfterStream :: Handle -> Handle -> IO ()
223readWriteBeforeAfterStream inh devNull =
224 let readEx =
225 Stream.after (hClose inh)
226 $ Stream.before (hPutChar devNull 'A') (Stream.unfold FH.reader inh)
227 in Stream.fold (FH.write devNull) readEx
229#ifdef INSPECTION
230inspect $ 'readWriteBeforeAfterStream `hasNoType` ''D.Step
231#endif
233readWriteAfterStream :: Handle -> Handle -> IO ()
234readWriteAfterStream inh devNull =
235 let readEx = Stream.after (hClose inh) (Stream.unfold FH.reader inh)
236 in Stream.fold (FH.write devNull) readEx
238#ifdef INSPECTION
239inspect $ 'readWriteAfterStream `hasNoType` ''D.Step
240#endif
242readWriteAfter_Stream :: Handle -> Handle -> IO ()
243readWriteAfter_Stream inh devNull =
244 let readEx = afterUnsafe (hClose inh) (Stream.unfold FH.reader inh)
245 in Stream.fold (FH.write devNull) readEx
247#ifdef INSPECTION
248inspect $ hasNoTypeClasses 'readWriteAfter_Stream
249inspect $ 'readWriteAfter_Stream `hasNoType` ''D.Step
250#endif
252o_1_space_copy_stream_exceptions :: BenchEnv -> [Benchmark]
253o_1_space_copy_stream_exceptions env =
254 [ bgroup "exceptions"
255 [ mkBenchSmall "Stream.onException" env $ \inh _ ->
256 readWriteOnExceptionStream inh (nullH env)
257 , mkBenchSmall "Stream.handle" env $ \inh _ ->
258 readWriteHandleExceptionStream inh (nullH env)
259 , mkBenchSmall "Stream.finally_" env $ \inh _ ->
260 readWriteFinally_Stream inh (nullH env)
261 , mkBenchSmall "Stream.finally" env $ \inh _ ->
262 readWriteFinallyStream inh (nullH env)
263 , mkBenchSmall "Stream.after . Stream.before" env $ \inh _ ->
264 readWriteBeforeAfterStream inh (nullH env)
265 , mkBenchSmall "Stream.after" env $ \inh _ ->
266 readWriteAfterStream inh (nullH env)
267 , mkBenchSmall "Stream.after_" env $ \inh _ ->
268 readWriteAfter_Stream inh (nullH env)
269 ]
270 , bgroup "exceptions/fromToBytes"
271 [ mkBenchSmall "Stream.bracket_" env $ \inh _ ->
272 fromToBytesBracket_Stream inh (nullH env)
273 , mkBenchSmall "Stream.bracket" env $ \inh _ ->
274 fromToBytesBracketStream inh (nullH env)
275 ]
276 ]
278 -------------------------------------------------------------------------------
279-- Exceptions readChunks
280-------------------------------------------------------------------------------
282-- | Send the file contents to /dev/null with exception handling
283readChunksOnException :: Handle -> Handle -> IO ()
284readChunksOnException inh devNull =
285 let readEx = IUF.onException (\_ -> hClose inh) FH.chunkReader
286 in IUF.fold (IFH.writeChunks devNull) readEx inh
288#ifdef INSPECTION
289inspect $ hasNoTypeClasses 'readChunksOnException
290#endif
292-- | Send the file contents to /dev/null with exception handling
293readChunksBracket_ :: Handle -> Handle -> IO ()
294readChunksBracket_ inh devNull =
295 let readEx = IUF.bracket_ return (\_ -> hClose inh) FH.chunkReader
296 in IUF.fold (IFH.writeChunks devNull) readEx inh
298#ifdef INSPECTION
299inspect $ hasNoTypeClasses 'readChunksBracket_
300#endif
302readChunksBracket :: Handle -> Handle -> IO ()
303readChunksBracket inh devNull =
304 let readEx = IUF.bracket return (\_ -> hClose inh) FH.chunkReader
305 in IUF.fold (IFH.writeChunks devNull) readEx inh
307o_1_space_copy_exceptions_readChunks :: BenchEnv -> [Benchmark]
308o_1_space_copy_exceptions_readChunks env =
309 [ bgroup "exceptions/readChunks"
310 [ mkBench "UF.onException" env $ \inH _ ->
311 readChunksOnException inH (nullH env)
312 , mkBench "UF.bracket_" env $ \inH _ ->
313 readChunksBracket_ inH (nullH env)
314 , mkBench "UF.bracket" env $ \inH _ ->
315 readChunksBracket inH (nullH env)
316 ]
317 ]
319-------------------------------------------------------------------------------
320-- Exceptions toChunks
321-------------------------------------------------------------------------------
323-- | Send the file contents to /dev/null with exception handling
324toChunksBracket_ :: Handle -> Handle -> IO ()
325toChunksBracket_ inh devNull =
326 let readEx = bracketUnsafe
327 (return ())
328 (\_ -> hClose inh)
329 (\_ -> fromStreamD $ IFH.readChunks inh)
330 in Stream.fold (IFH.writeChunks devNull) readEx
332#ifdef INSPECTION
333inspect $ hasNoTypeClasses 'toChunksBracket_
334#endif
336toChunksBracket :: Handle -> Handle -> IO ()
337toChunksBracket inh devNull =
338 let readEx = Stream.bracket
339 (return ())
340 (\_ -> hClose inh)
341 (\_ -> fromStreamD $ IFH.readChunks inh)
342 in Stream.fold (IFH.writeChunks devNull) readEx
344o_1_space_copy_exceptions_toChunks :: BenchEnv -> [Benchmark]
345o_1_space_copy_exceptions_toChunks env =
346 [ bgroup "exceptions/toChunks"
347 [ mkBench "Stream.bracket_" env $ \inH _ ->
348 toChunksBracket_ inH (nullH env)
349 , mkBench "Stream.bracket" env $ \inH _ ->
350 toChunksBracket inH (nullH env)
351 ]
352 ]
354benchmarks :: String -> BenchEnv -> Int -> [Benchmark]
355benchmarks moduleName _env size =
356 [ bgroup (o_1_space_prefix moduleName) $ concat
357 [ o_1_space_serial_exceptions size
358 , o_1_space_copy_exceptions_readChunks _env
359 , o_1_space_copy_exceptions_toChunks _env
360 , o_1_space_copy_stream_exceptions _env
361 ]
362 ]