98b4fc3 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

clear the finalizer from IORef on exception

98b4fc3Harendra Kumar7 years ago

src/Streamly/Internal/Data/Stream/StreamD.hs+23−7

compare with master

unifiedsplit

@@ -296,6 +296,8 @@ module Streamly.Internal.Data.Stream.StreamD

296

297 -- * Exceptions

298 , newFinalizedIORef

299+ , runIORefFinalizer

300+ , clearIORefFinalizer

299 , gbracket

301 , gbracket

300 , before

302 , before

301 , after

303 , after

@@ -2899,6 +2901,21 @@ newFinalizedIORef finalizer = do

2899 _ <- liftIO $ mkWeakIORef ref finalizer1

2901 _ <- liftIO $ mkWeakIORef ref finalizer1

2900 return ref

2902 return ref

2901

2903

2904+-- | Run the finalizer stored in an IORef and deactivate it so that it is run

2905+-- only once.

2906+--

2907+runIORefFinalizer :: MonadIO m => IORef (Maybe (IO ())) -> m ()

2908+runIORefFinalizer ref = liftIO $ do

2909+ res <- readIORef ref

2910+ case res of

2911+ Nothing -> return ()

2912+ Just f -> writeIORef ref Nothing >> f

2913+

2914+-- | Deactivate the finalizer stored in an IORef without running it.

2915+--

2916+clearIORefFinalizer :: MonadIO m => IORef (Maybe (IO ())) -> m ()

2917+clearIORefFinalizer ref = liftIO $ writeIORef ref Nothing

2918+

2902data GbracketIOState s1 s2 v wref

2919data GbracketIOState s1 s2 v wref

2903 = GBracketIOInit

2920 = GBracketIOInit

2904 | GBracketIONormal s1 v wref

2921 | GBracketIONormal s1 v wref

@@ -2946,10 +2963,10 @@ gbracketIO bef exc aft fexc fnormal =

2946 Skip s ->

2963 Skip s ->

2947 return $ Skip (GBracketIONormal (Stream step1 s) v ref)

2964 return $ Skip (GBracketIONormal (Stream step1 s) v ref)

2948 Stop -> do

2965 Stop -> do

2949− liftIO (writeIORef ref Nothing)

2966+ runIORefFinalizer ref

2950− aft v >> return Stop

2967+ return Stop

2951 Left e -> do

2968 Left e -> do

2952− liftIO (writeIORef ref Nothing)

2969+ clearIORefFinalizer ref

2953 return $ Skip (GBracketIOException (fexc v e))

2970 return $ Skip (GBracketIOException (fexc v e))

2954 step gst (GBracketIOException (UnStream step1 st)) = do

2971 step gst (GBracketIOException (UnStream step1 st)) = do

2955 res <- step1 gst st

2972 res <- step1 gst st

@@ -3007,10 +3024,9 @@ afterIO action (Stream step state) = Stream step' Nothing

3007 case res of

3024 case res of

3008 Yield x s -> return $ Yield x (Just (s, ref))

3025 Yield x s -> return $ Yield x (Just (s, ref))

3009 Skip s -> return $ Skip (Just (s, ref))

3026 Skip s -> return $ Skip (Just (s, ref))

3010− Stop -> liftIO $ do

3027+ Stop -> do

3011− Just f <- readIORef ref

3028+ runIORefFinalizer ref

3012− writeIORef ref Nothing

3013− f >> return Stop

3029+ return Stop

3014

3030

3015-- XXX These combinators are expensive due to the call to

3031-- XXX These combinators are expensive due to the call to

3016-- onException/handle/try on each step. Therefore, when possible, they should

3032-- onException/handle/try on each step. Therefore, when possible, they should

src/Streamly/Internal/Data/Unfold.hs+20−22

@@ -128,7 +128,6 @@ where

128import Control.Exception (Exception)

129import Control.Monad.IO.Class (MonadIO(..))

130import Control.Monad.Trans.Control (MonadBaseControl)

131−import Data.IORef (readIORef, writeIORef)

132import Data.Void (Void)

131import Data.Void (Void)

133import GHC.Types (SPEC(..))

132import GHC.Types (SPEC(..))

134import Prelude hiding (concat, map, mapM, takeWhile, take, filter, const)

133import Prelude hiding (concat, map, mapM, takeWhile, take, filter, const)

@@ -694,10 +693,10 @@ gbracketIO bef exc aft (Unfold estep einject) (Unfold step1 inject1) =

694 Yield x s -> return $ Yield x (Right (s, v, ref))

693 Yield x s -> return $ Yield x (Right (s, v, ref))

695 Skip s -> return $ Skip (Right (s, v, ref))

694 Skip s -> return $ Skip (Right (s, v, ref))

696 Stop -> do

695 Stop -> do

697− liftIO $ writeIORef ref Nothing

696+ D.runIORefFinalizer ref

698− aft v >> return Stop

697+ return Stop

699 Left e -> do

698 Left e -> do

700− liftIO (writeIORef ref Nothing)

699+ D.clearIORefFinalizer ref

701 r <- einject (v, e)

700 r <- einject (v, e)

702 return $ Skip (Left r)

701 return $ Skip (Left r)

703 step (Left st) = do

702 step (Left st) = do

@@ -789,10 +788,9 @@ afterIO action (Unfold step1 inject1) = Unfold step inject

789 case res of

788 case res of

790 Yield x s -> return $ Yield x (s, ref)

789 Yield x s -> return $ Yield x (s, ref)

791 Skip s -> return $ Skip (s, ref)

790 Skip s -> return $ Skip (s, ref)

792− Stop -> liftIO $ do

791+ Stop -> do

793− Just f <- readIORef ref

792+ D.runIORefFinalizer ref

794− writeIORef ref Nothing

795− f >> return Stop

793+ return Stop

796

794

797{-# INLINE_NORMAL _onException #-}

795{-# INLINE_NORMAL _onException #-}

798_onException :: MonadCatch m => (a -> m c) -> Unfold m a b -> Unfold m a b

796_onException :: MonadCatch m => (a -> m c) -> Unfold m a b -> Unfold m a b

@@ -868,17 +866,17 @@ finallyIO action (Unfold step1 inject1) = Unfold step inject

868 inject x = do

866 inject x = do

869 s <- inject1 x

867 s <- inject1 x

870 ref <- D.newFinalizedIORef (action x)

868 ref <- D.newFinalizedIORef (action x)

871− return (s, x, ref)

869+ return (s, ref)

872

870

873 {-# INLINE_LATE step #-}

871 {-# INLINE_LATE step #-}

874− step (st, v, ref) = do

872+ step (st, ref) = do

875− res <- step1 st `MC.onException` action v

873+ res <- step1 st `MC.onException` D.runIORefFinalizer ref

876 case res of

874 case res of

877− Yield x s -> return $ Yield x (s, v, ref)

875+ Yield x s -> return $ Yield x (s, ref)

878− Skip s -> return $ Skip (s, v, ref)

876+ Skip s -> return $ Skip (s, ref)

879 Stop -> do

877 Stop -> do

880− liftIO (writeIORef ref Nothing)

878+ D.runIORefFinalizer ref

881− action v >> return Stop

879+ return Stop

882

880

883{-# INLINE_NORMAL _bracket #-}

881{-# INLINE_NORMAL _bracket #-}

884_bracket :: MonadCatch m

882_bracket :: MonadCatch m

@@ -935,17 +933,17 @@ bracketIO bef aft (Unfold step1 inject1) = Unfold step inject

935 r <- bef x

933 r <- bef x

936 s <- inject1 r

934 s <- inject1 r

937 ref <- D.newFinalizedIORef (aft r)

935 ref <- D.newFinalizedIORef (aft r)

938− return (s, r, ref)

936+ return (s, ref)

939

937

940 {-# INLINE_LATE step #-}

938 {-# INLINE_LATE step #-}

941− step (st, v, ref) = do

939+ step (st, ref) = do

942− res <- step1 st `MC.onException` aft v

940+ res <- step1 st `MC.onException` D.runIORefFinalizer ref

943 case res of

941 case res of

944− Yield x s -> return $ Yield x (s, v, ref)

942+ Yield x s -> return $ Yield x (s, ref)

945− Skip s -> return $ Skip (s, v, ref)

943+ Skip s -> return $ Skip (s, ref)

946 Stop -> do

944 Stop -> do

947− liftIO (writeIORef ref Nothing)

945+ D.runIORefFinalizer ref

948− aft v >> return Stop

946+ return Stop

949

947

950-- | When unfolding if an exception occurs, unfold the exception using the

948-- | When unfolding if an exception occurs, unfold the exception using the

951-- exception unfold supplied as the first argument to 'handle'.

949-- exception unfold supplied as the first argument to 'handle'.