@@ -20,9 +20,12 @@
2020
2121module Serial.Exceptions (benchmarks) where
2222
23−import Control.Exception (SomeException)
23+import Control.Exception (SomeException, Exception, throwIO)
2424import System.IO (Handle, hClose, hPutChar)
2525
26+import qualified Data.IORef as Ref
27+import qualified Data.Map.Strict as Map
28+
2629import qualified Streamly.FileSystem.Handle as FH
2730import qualified Streamly.Internal.Data.Unfold as IUF
2831import qualified Streamly.Internal.FileSystem.Handle as IFH
@@ -44,6 +47,79 @@ import qualified Streamly.Internal.Data.Stream.StreamD as D
4447-- stream exceptions
4548-------------------------------------------------------------------------------
4649
50+data BenchException
51+ = BenchException1
52+ | BenchException2
53+ deriving (Show, Eq, Ord)
54+
55+instance Exception BenchException
56+
57+retryNoneSimple :: Int -> Int -> IO ()
58+retryNoneSimple length from =
59+ IP.drain
60+ $ IP.retry (Map.singleton BenchException1 length) (const S.nil) source
61+
62+ where
63+
64+ source = S.enumerateFromTo from (from + length)
65+
66+retryNone :: Int -> Int -> IO ()
67+retryNone length from = do
68+ ref <- Ref.newIORef (0 :: Int)
69+ IP.drain
70+ $ IP.retry (Map.singleton BenchException1 length) (const S.nil)
71+ $ source ref
72+
73+ where
74+
75+ source ref =
76+ IP.replicateM (from + length)
77+ $ Ref.modifyIORef' ref (+ 1) >> Ref.readIORef ref
78+
79+retryAll :: Int -> Int -> IO ()
80+retryAll length from = do
81+ ref <- Ref.newIORef 0
82+ IP.drain
83+ $ IP.retry (Map.singleton BenchException1 (length + from)) (const S.nil)
84+ $ source ref
85+
86+ where
87+
88+ source ref =
89+ IP.fromEffect
90+ $ do
91+ Ref.modifyIORef' ref (+ 1)
92+ val <- Ref.readIORef ref
93+ if val >= length
94+ then return length
95+ else throwIO BenchException1
96+
97+retryUnknown :: Int -> Int -> IO ()
98+retryUnknown length from = do
99+ IP.drain
100+ $ IP.retry (Map.singleton BenchException1 length) (const source)
101+ $ throwIO BenchException2 `S.before` S.nil
102+
103+ where
104+
105+ source = S.enumerateFromTo from (from + length)
106+
107+
108+o_1_space_serial_exceptions :: Int -> [Benchmark]
109+o_1_space_serial_exceptions length =
110+ [ bgroup
111+ "exceptions/serial"
112+ [ benchIOSrc1 "retryNoneSimple" (retryNoneSimple length)
113+ , benchIOSrc1 "retryNone" (retryNone length)
114+ , benchIOSrc1 "retryAll" (retryAll length)
115+ , benchIOSrc1 "retryUnknown" (retryUnknown length)
116+ ]
117+ ]
118+
119+-------------------------------------------------------------------------------
120+-- copy stream exceptions
121+-------------------------------------------------------------------------------
122+
47123-- | Send the file contents to /dev/null with exception handling
48124readWriteOnExceptionStream :: Handle -> Handle -> IO ()
49125readWriteOnExceptionStream inh devNull =
@@ -230,11 +306,12 @@ o_1_space_copy_exceptions_toChunks env =
230306 ]
231307
232308
233−benchmarks :: String -> BenchEnv -> [Benchmark]
234−benchmarks moduleName env =
309+benchmarks :: String -> BenchEnv -> Int -> [Benchmark]
310+benchmarks moduleName env size =
235311 [ bgroup (o_1_space_prefix moduleName) $ concat
236312 [ o_1_space_copy_exceptions_readChunks env
237313 , o_1_space_copy_exceptions_toChunks env
238314 , o_1_space_copy_stream_exceptions env
315+ , o_1_space_serial_exceptions size
239316 ]
240317 ]