module Darcs.Util.AtExit
(
atexit
, withAtexit
) where
import Darcs.Prelude
import Control.Concurrent.MVar
import Control.Exception
( bracket_, catch, SomeException
, mask
)
import System.IO.Unsafe (unsafePerformIO)
import System.IO ( hPutStrLn, stderr, hPrint )
atexitActions :: MVar (Maybe [IO ()])
atexitActions :: MVar (Maybe [IO ()])
atexitActions = forall a. IO a -> a
unsafePerformIO (forall a. a -> IO (MVar a)
newMVar (forall a. a -> Maybe a
Just []))
{-# NOINLINE atexitActions #-}
atexit :: IO ()
-> IO ()
atexit :: IO () -> IO ()
atexit IO ()
action =
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar (Maybe [IO ()])
atexitActions forall a b. (a -> b) -> a -> b
$ \Maybe [IO ()]
ml ->
case Maybe [IO ()]
ml of
Just [IO ()]
l ->
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (IO ()
action forall a. a -> [a] -> [a]
: [IO ()]
l))
Maybe [IO ()]
Nothing -> do
Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"It's too late to use atexit"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
withAtexit :: IO a -> IO a
withAtexit :: forall a. IO a -> IO a
withAtexit = forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ (forall (m :: * -> *) a. Monad m => a -> m a
return ()) IO ()
exit
where
exit :: IO ()
exit = forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
unmask -> do
Just [IO ()]
actions <- forall a. MVar a -> a -> IO a
swapMVar MVar (Maybe [IO ()])
atexitActions forall a. Maybe a
Nothing
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall {t}. (t -> IO ()) -> t -> IO ()
runAction forall a. IO a -> IO a
unmask) [IO ()]
actions
runAction :: (t -> IO ()) -> t -> IO ()
runAction t -> IO ()
unmask t
action =
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (t -> IO ()
unmask t
action) forall a b. (a -> b) -> a -> b
$ \(SomeException
exn :: SomeException) -> do
Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"Exception thrown by an atexit registered action:"
forall a. Show a => Handle -> a -> IO ()
hPrint Handle
stderr SomeException
exn