git.iko.soy/streamly
on 0717458 help sign in
streamly/benchmark/Streamly/Benchmark/Data/Stream/Exceptions.hs
352 lines 11 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 = Stream.finally_ (hClose inh) (Stream.unfold FH.reader inh)
180 in Stream.fold (FH.write devNull) readEx
182#ifdef INSPECTION
183inspect $ hasNoTypeClasses 'readWriteFinally_Stream
184#endif
186readWriteFinallyStream :: Handle -> Handle -> IO ()
187readWriteFinallyStream inh devNull =
188 let readEx = Stream.finally (hClose inh) (Stream.unfold FH.reader inh)
189 in Stream.fold (FH.write devNull) readEx
191-- | Send the file contents to /dev/null with exception handling
192fromToBytesBracket_Stream :: Handle -> Handle -> IO ()
193fromToBytesBracket_Stream inh devNull =
194 let readEx = Stream.bracket_ (return ()) (\_ -> hClose inh)
195 (\_ -> IFH.read inh)
196 in IFH.putBytes devNull readEx
198#ifdef INSPECTION
199inspect $ hasNoTypeClasses 'fromToBytesBracket_Stream
200#endif
202fromToBytesBracketStream :: Handle -> Handle -> IO ()
203fromToBytesBracketStream inh devNull =
204 let readEx = Stream.bracket (return ()) (\_ -> hClose inh)
205 (\_ -> IFH.read inh)
206 in IFH.putBytes devNull readEx
208readWriteBeforeAfterStream :: Handle -> Handle -> IO ()
209readWriteBeforeAfterStream inh devNull =
210 let readEx =
211 Stream.after (hClose inh)
212 $ Stream.before (hPutChar devNull 'A') (Stream.unfold FH.reader inh)
213 in Stream.fold (FH.write devNull) readEx
215#ifdef INSPECTION
216inspect $ 'readWriteBeforeAfterStream `hasNoType` ''D.Step
217#endif
219readWriteAfterStream :: Handle -> Handle -> IO ()
220readWriteAfterStream inh devNull =
221 let readEx = Stream.after (hClose inh) (Stream.unfold FH.reader inh)
222 in Stream.fold (FH.write devNull) readEx
224#ifdef INSPECTION
225inspect $ 'readWriteAfterStream `hasNoType` ''D.Step
226#endif
228readWriteAfter_Stream :: Handle -> Handle -> IO ()
229readWriteAfter_Stream inh devNull =
230 let readEx = Stream.after_ (hClose inh) (Stream.unfold FH.reader inh)
231 in Stream.fold (FH.write devNull) readEx
233#ifdef INSPECTION
234inspect $ hasNoTypeClasses 'readWriteAfter_Stream
235inspect $ 'readWriteAfter_Stream `hasNoType` ''D.Step
236#endif
238o_1_space_copy_stream_exceptions :: BenchEnv -> [Benchmark]
239o_1_space_copy_stream_exceptions env =
240 [ bgroup "exceptions"
241 [ mkBenchSmall "Stream.onException" env $ \inh _ ->
242 readWriteOnExceptionStream inh (nullH env)
243 , mkBenchSmall "Stream.handle" env $ \inh _ ->
244 readWriteHandleExceptionStream inh (nullH env)
245 , mkBenchSmall "Stream.finally_" env $ \inh _ ->
246 readWriteFinally_Stream inh (nullH env)
247 , mkBenchSmall "Stream.finally" env $ \inh _ ->
248 readWriteFinallyStream inh (nullH env)
249 , mkBenchSmall "Stream.after . Stream.before" env $ \inh _ ->
250 readWriteBeforeAfterStream inh (nullH env)
251 , mkBenchSmall "Stream.after" env $ \inh _ ->
252 readWriteAfterStream inh (nullH env)
253 , mkBenchSmall "Stream.after_" env $ \inh _ ->
254 readWriteAfter_Stream inh (nullH env)
255 ]
256 , bgroup "exceptions/fromToBytes"
257 [ mkBenchSmall "Stream.bracket_" env $ \inh _ ->
258 fromToBytesBracket_Stream inh (nullH env)
259 , mkBenchSmall "Stream.bracket" env $ \inh _ ->
260 fromToBytesBracketStream inh (nullH env)
261 ]
262 ]
264 -------------------------------------------------------------------------------
265-- Exceptions readChunks
266-------------------------------------------------------------------------------
268-- | Send the file contents to /dev/null with exception handling
269readChunksOnException :: Handle -> Handle -> IO ()
270readChunksOnException inh devNull =
271 let readEx = IUF.onException (\_ -> hClose inh) FH.chunkReader
272 in IUF.fold (IFH.writeChunks devNull) readEx inh
274#ifdef INSPECTION
275inspect $ hasNoTypeClasses 'readChunksOnException
276#endif
278-- | Send the file contents to /dev/null with exception handling
279readChunksBracket_ :: Handle -> Handle -> IO ()
280readChunksBracket_ inh devNull =
281 let readEx = IUF.bracket_ return (\_ -> hClose inh) FH.chunkReader
282 in IUF.fold (IFH.writeChunks devNull) readEx inh
284#ifdef INSPECTION
285inspect $ hasNoTypeClasses 'readChunksBracket_
286#endif
288readChunksBracket :: Handle -> Handle -> IO ()
289readChunksBracket inh devNull =
290 let readEx = IUF.bracket return (\_ -> hClose inh) FH.chunkReader
291 in IUF.fold (IFH.writeChunks devNull) readEx inh
293o_1_space_copy_exceptions_readChunks :: BenchEnv -> [Benchmark]
294o_1_space_copy_exceptions_readChunks env =
295 [ bgroup "exceptions/readChunks"
296 [ mkBench "UF.onException" env $ \inH _ ->
297 readChunksOnException inH (nullH env)
298 , mkBench "UF.bracket_" env $ \inH _ ->
299 readChunksBracket_ inH (nullH env)
300 , mkBench "UF.bracket" env $ \inH _ ->
301 readChunksBracket inH (nullH env)
302 ]
303 ]
305-------------------------------------------------------------------------------
306-- Exceptions toChunks
307-------------------------------------------------------------------------------
309-- | Send the file contents to /dev/null with exception handling
310toChunksBracket_ :: Handle -> Handle -> IO ()
311toChunksBracket_ inh devNull =
312 let readEx = Stream.bracket_
313 (return ())
314 (\_ -> hClose inh)
315 (\_ -> IFH.readChunks inh)
316 in Stream.fold (IFH.writeChunks devNull) readEx
318#ifdef INSPECTION
319inspect $ hasNoTypeClasses 'toChunksBracket_
320#endif
322toChunksBracket :: Handle -> Handle -> IO ()
323toChunksBracket inh devNull =
324 let readEx = Stream.bracket
325 (return ())
326 (\_ -> hClose inh)
327 (\_ -> IFH.readChunks inh)
328 in Stream.fold (IFH.writeChunks devNull) readEx
330o_1_space_copy_exceptions_toChunks :: BenchEnv -> [Benchmark]
331o_1_space_copy_exceptions_toChunks env =
332 [ bgroup "exceptions/toChunks"
333 [ mkBench "Stream.bracket_" env $ \inH _ ->
334 toChunksBracket_ inH (nullH env)
335 , mkBench "Stream.bracket" env $ \inH _ ->
336 toChunksBracket inH (nullH env)
337 ]
338 ]
340#endif
342benchmarks :: String -> BenchEnv -> Int -> [Benchmark]
343benchmarks moduleName _env size =
344 [ bgroup (o_1_space_prefix moduleName) $ concat
345 [ o_1_space_serial_exceptions size
346#ifndef USE_STREAMLY_CORE
347 , o_1_space_copy_exceptions_readChunks _env
348 , o_1_space_copy_exceptions_toChunks _env
349 , o_1_space_copy_stream_exceptions _env
350#endif
351 ]
352 ]