module Darcs.Global ( atexit, with_atexit,
sshControlMasterDisabled, setSshControlMasterDisabled,
verboseMode, setVerboseMode,
timingsMode, setTimingsMode,
whenDebugMode, withDebugMode, setDebugMode,
debugMessage, debugFail, putTiming,
addCRCWarning, getCRCWarnings, resetCRCWarnings,
darcsdir
) where
import Control.Monad ( when )
import Control.Concurrent.MVar
import Control.Exception (bracket_, catch, block, unblock)
import Data.IORef ( IORef, newIORef, readIORef, writeIORef )
import Data.IORef ( modifyIORef )
import System.IO.Unsafe (unsafePerformIO)
import System.IO (hPutStrLn, hPutStr, stderr)
import System.Time ( calendarTimeToString, toCalendarTime, getClockTime )
import Prelude hiding (catch)
atexit_actions :: MVar (Maybe [IO ()])
atexit_actions = unsafePerformIO (newMVar (Just []))
atexit :: IO () -> IO ()
atexit action = do
modifyMVar_ atexit_actions $ \ml -> do
case ml of
Just l -> do
return (Just (action : l))
Nothing -> do
hPutStrLn stderr "It's too late to use atexit"
return Nothing
with_atexit :: IO a -> IO a
with_atexit prog = do
bracket_
(return ())
exit
prog
where
exit = block $ do
Just actions <- swapMVar atexit_actions Nothing
mapM_ runAction actions
runAction action = do
catch (unblock action) $ \exn -> do
hPutStrLn stderr $ "Exception thrown by an atexit registered action:"
hPutStrLn stderr $ show exn
_debugMode :: IORef Bool
_debugMode = unsafePerformIO $ newIORef False
setDebugMode :: IO ()
setDebugMode = writeIORef _debugMode True
whenDebugMode :: IO () -> IO ()
whenDebugMode j = do b <- readIORef _debugMode
when b j
withDebugMode :: (Bool -> IO a) -> IO a
withDebugMode j = readIORef _debugMode >>= j
debugMessage :: String -> IO ()
debugMessage m = whenDebugMode $ do putTiming; hPutStrLn stderr m
debugFail :: String -> IO a
debugFail m = debugMessage m >> fail m
putTiming :: IO ()
putTiming = when timingsMode $ do t <- getClockTime >>= toCalendarTime
hPutStr stderr (calendarTimeToString t++": ")
_timingsMode :: IORef Bool
_timingsMode = unsafePerformIO $ newIORef False
setTimingsMode :: IO ()
setTimingsMode = writeIORef _timingsMode True
timingsMode :: Bool
timingsMode = unsafePerformIO $ readIORef _timingsMode
_verboseMode :: IORef Bool
_verboseMode = unsafePerformIO $ newIORef False
setVerboseMode :: IO ()
setVerboseMode = writeIORef _verboseMode True
verboseMode :: Bool
verboseMode = unsafePerformIO $ readIORef _verboseMode
_sshControlMasterDisabled :: IORef Bool
_sshControlMasterDisabled = unsafePerformIO $ newIORef False
setSshControlMasterDisabled :: IO ()
setSshControlMasterDisabled = writeIORef _sshControlMasterDisabled True
sshControlMasterDisabled :: Bool
sshControlMasterDisabled = unsafePerformIO $ readIORef _sshControlMasterDisabled
type CRCWarningList = [FilePath]
_crcWarningList :: IORef CRCWarningList
_crcWarningList = unsafePerformIO $ newIORef []
addCRCWarning :: FilePath -> IO ()
addCRCWarning fp = modifyIORef _crcWarningList (fp:)
getCRCWarnings :: IO [FilePath]
getCRCWarnings = readIORef _crcWarningList
resetCRCWarnings :: IO ()
resetCRCWarnings = writeIORef _crcWarningList []
darcsdir :: String
darcsdir = "_darcs"