module Darcs.Util.Global
(
timingsMode
, setTimingsMode
, whenDebugMode
, withDebugMode
, setDebugMode
, debugMessage
, putTiming
, addCRCWarning
, getCRCWarnings
, resetCRCWarnings
, darcsdir
, darcsLastMessage
, darcsSendMessage
, darcsSendMessageFinal
, defaultRemoteDarcsCmd
) where
import Darcs.Prelude
import Control.Monad ( when )
import Data.IORef ( modifyIORef, IORef, newIORef, readIORef, writeIORef )
import System.IO.Unsafe (unsafePerformIO)
import System.IO ( hPutStrLn, hPutStr, stderr )
import System.Time ( calendarTimeToString, toCalendarTime, getClockTime )
import System.FilePath.Posix ( combine, (<.>) )
_debugMode :: IORef Bool
_debugMode = unsafePerformIO $ newIORef False
{-# NOINLINE _debugMode #-}
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
putTiming :: IO ()
putTiming = when timingsMode $ do
t <- getClockTime >>= toCalendarTime
hPutStr stderr (calendarTimeToString t++": ")
_timingsMode :: IORef Bool
_timingsMode = unsafePerformIO $ newIORef False
{-# NOINLINE _timingsMode #-}
setTimingsMode :: IO ()
setTimingsMode = writeIORef _timingsMode True
timingsMode :: Bool
timingsMode = unsafePerformIO $ readIORef _timingsMode
{-# NOINLINE timingsMode #-}
type CRCWarningList = [FilePath]
_crcWarningList :: IORef CRCWarningList
_crcWarningList = unsafePerformIO $ newIORef []
{-# NOINLINE _crcWarningList #-}
addCRCWarning :: FilePath -> IO ()
addCRCWarning fp = modifyIORef _crcWarningList (fp:)
getCRCWarnings :: IO [FilePath]
getCRCWarnings = readIORef _crcWarningList
resetCRCWarnings :: IO ()
resetCRCWarnings = writeIORef _crcWarningList []
darcsdir :: String
darcsdir = "_darcs"
defaultRemoteDarcsCmd :: String
defaultRemoteDarcsCmd = "darcs"
darcsLastMessage :: String
darcsLastMessage = combine darcsdir "patch_description.txt"
darcsSendMessage :: String
darcsSendMessage = combine darcsdir "darcs-send"
darcsSendMessageFinal :: String
darcsSendMessageFinal = darcsSendMessage <.> "final"