-- Copyright (C) 2005 Tomasz Zielonka
--
-- This program is free software; you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation; either version 2, or (at your option)
-- any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program; see the file COPYING.  If not, write to
-- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-- Boston, MA 02110-1301, USA.

-- |
-- Module      : Darcs.Util.AtExit
-- Copyright   : 2005 Tomasz Zielonka
-- License     : GPL
-- Maintainer  : darcs-devel@darcs.net
-- Stability   : experimental
-- Portability : portable
--
-- This was originally Tomasz Zielonka's AtExit module, slightly generalised
-- to include global variables.  Here, we attempt to cover broad, global
-- features, such as exit handlers.  These features slightly break the Haskellian
-- purity of darcs, in favour of programming convenience.

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 = IO (MVar (Maybe [IO ()])) -> MVar (Maybe [IO ()])
forall a. IO a -> a
unsafePerformIO (Maybe [IO ()] -> IO (MVar (Maybe [IO ()]))
forall a. a -> IO (MVar a)
newMVar ([IO ()] -> Maybe [IO ()]
forall a. a -> Maybe a
Just []))
{-# NOINLINE atexitActions #-}


-- | Registers an IO action to run just before darcs exits. Useful for removing
-- temporary files and directories, for example. Referenced in Issue1914.
atexit :: IO ()
       -> IO ()
atexit :: IO () -> IO ()
atexit IO ()
action =
    MVar (Maybe [IO ()])
-> (Maybe [IO ()] -> IO (Maybe [IO ()])) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar (Maybe [IO ()])
atexitActions ((Maybe [IO ()] -> IO (Maybe [IO ()])) -> IO ())
-> (Maybe [IO ()] -> IO (Maybe [IO ()])) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Maybe [IO ()]
ml ->
        case Maybe [IO ()]
ml of
            Just [IO ()]
l ->
                Maybe [IO ()] -> IO (Maybe [IO ()])
forall (m :: * -> *) a. Monad m => a -> m a
return ([IO ()] -> Maybe [IO ()]
forall a. a -> Maybe a
Just (IO ()
action IO () -> [IO ()] -> [IO ()]
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"
                Maybe [IO ()] -> IO (Maybe [IO ()])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [IO ()]
forall a. Maybe a
Nothing


withAtexit :: IO a -> IO a
withAtexit :: IO a -> IO a
withAtexit = IO () -> IO () -> IO a -> IO a
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) IO ()
exit
  where
    exit :: IO ()
exit = ((forall a. IO a -> IO a) -> IO ()) -> IO ()
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO ()) -> IO ())
-> ((forall a. IO a -> IO a) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
unmask -> do
        Just [IO ()]
actions <- MVar (Maybe [IO ()]) -> Maybe [IO ()] -> IO (Maybe [IO ()])
forall a. MVar a -> a -> IO a
swapMVar MVar (Maybe [IO ()])
atexitActions Maybe [IO ()]
forall a. Maybe a
Nothing
        -- from now on atexit will not register new actions
        (IO () -> IO ()) -> [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((IO () -> IO ()) -> IO () -> IO ()
forall t. (t -> IO ()) -> t -> IO ()
runAction IO () -> IO ()
forall a. IO a -> IO a
unmask) [IO ()]
actions
    runAction :: (t -> IO ()) -> t -> IO ()
runAction t -> IO ()
unmask t
action =
        IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (t -> IO ()
unmask t
action) ((SomeException -> IO ()) -> IO ())
-> (SomeException -> IO ()) -> IO ()
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:"
            Handle -> SomeException -> IO ()
forall a. Show a => Handle -> a -> IO ()
hPrint Handle
stderr SomeException
exn