@@ -11,7 +11,7 @@ module Streamly.Test.Prelude.Common
1111 (
1212 -- * Construction operations
1313 constructWithRepeat
14− , constructWithRepeatM
14+ , constructWithRepeatM
1515 , constructWithReplicate
1616 , constructWithReplicateM
1717 , constructWithIntFromThenTo
@@ -1378,29 +1378,100 @@ parallelCheck t f = do
13781378-- Exception ops
13791379-------------------------------------------------------------------------------
13801380
1381−exceptionOps :: IsStream t => String -> (t IO Int -> SerialT IO Int) -> Spec
1382−exceptionOps desc t = do
1383− prop (desc <> " before") $ beforeProp t
1384− prop (desc <> " after") $ afterProp t
1385−
13861381beforeProp :: IsStream t => (t IO Int -> SerialT IO Int) -> [Int] -> Property
1387−beforeProp t vec = withMaxSuccess maxTestCount $
1382+beforeProp t vec =
1383+ withMaxSuccess maxTestCount $
13881384 monadicIO $ do
13891385 ioRef <- run $ newIORef False
1390− strm <- run $ S.toList . t $ S.before (writeIORef ioRef True) (S.fromList vec)
1386+ strm <-
1387+ run $
1388+ S.toList . t $ S.before (writeIORef ioRef True) (S.fromList vec)
13911389 refValue <- run $ readIORef ioRef
13921390 assert refValue
13931391 assert $ sort strm == sort vec
1394−
1392+
13951393afterProp :: IsStream t => (t IO Int -> SerialT IO Int) -> [Int] -> Property
1396−afterProp t vec = withMaxSuccess maxTestCount $
1394+afterProp t vec =
1395+ withMaxSuccess maxTestCount $
13971396 monadicIO $ do
13981397 ioRef <- run $ newIORef False
1399− strm <- run $ S.toList . t $ S.after (writeIORef ioRef True) (S.fromList vec)
1398+ strm <-
1399+ run $
1400+ S.toList . t $ S.after (writeIORef ioRef True) (S.fromList vec)
14001401 refValue <- run $ readIORef ioRef
14011402 assert refValue
14021403 assert $ sort strm == sort vec
14031404
1405+bracketProp :: (IsStream t) => (t IO Int -> SerialT IO Int) -> [Int] -> Property
1406+bracketProp t vec =
1407+ withMaxSuccess maxTestCount $
1408+ monadicIO $ do
1409+ ioRef <- run $ newIORef (0 :: Int)
1410+ run $
1411+ S.drain . t $
1412+ S.bracket
1413+ (return ioRef)
1414+ (`writeIORef` 1)
1415+ (\ioref ->
1416+ S.mapM
1417+ (\a -> writeIORef ioref 2 >> return a)
1418+ (S.fromList []))
1419+ refValue <- run $ readIORef ioRef
1420+ assert $ refValue == 1
1421+
1422+-- XXX This test fails
1423+_bracketPartialStreamProp ::
1424+ (IsStream t) => (t IO Int -> SerialT IO Int) -> [Int] -> Property
1425+_bracketPartialStreamProp t vec =
1426+ forAll (choose (0, length vec)) $ \len -> do
1427+ withMaxSuccess maxTestCount $
1428+ monadicIO $ do
1429+ ioRef <- run $ newIORef (0 :: Int)
1430+ run $
1431+ S.drain . t $
1432+ S.take len $
1433+ S.bracket
1434+ (return ioRef)
1435+ (`writeIORef` 1)
1436+ (\ioref ->
1437+ S.mapM
1438+ (\a -> writeIORef ioref 2 >> return a)
1439+ (S.fromList vec))
1440+ run performMajorGC
1441+ refValue <- run $ readIORef ioRef
1442+ assert $ refValue == 1
1443+
1444+bracketExceptionProp ::
1445+ (IsStream t, MonadThrow (t IO))
1446+ => (t IO Int -> SerialT IO Int)
1447+ -> Property
1448+bracketExceptionProp t =
1449+ withMaxSuccess maxTestCount $
1450+ monadicIO $ do
1451+ ioRef <- run $ newIORef (0 :: Int)
1452+ res <-
1453+ run $
1454+ try . S.drain . t $
1455+ S.bracket
1456+ (return ioRef)
1457+ (`writeIORef` 1)
1458+ (const $ throwM (ExampleException "E") <> S.nil)
1459+ assert $ res == Left (ExampleException "E")
1460+ refValue <- run $ readIORef ioRef
1461+ assert $ refValue == 1
1462+
1463+exceptionOps ::
1464+ (IsStream t, MonadThrow (t IO))
1465+ => String
1466+ -> (t IO Int -> SerialT IO Int)
1467+ -> Spec
1468+exceptionOps desc t = do
1469+ prop (desc <> " before") $ beforeProp t
1470+ prop (desc <> " after") $ afterProp t
1471+ prop (desc <> " bracket end of stream") $ bracketProp t
1472+ -- prop (desc <> " bracket partial stream") $ bracketPartialStreamProp t
1473+ prop (desc <> " bracket exception in stream") $ bracketExceptionProp t
1474+
14041475-------------------------------------------------------------------------------
14051476-- Compose with MonadThrow
14061477-------------------------------------------------------------------------------