module Darcs.Util.Global
(
timingsMode
, setTimingsMode
, whenDebugMode
, withDebugMode
, setDebugMode
, debugMessage
, debugFail
, putTiming
, addCRCWarning
, getCRCWarnings
, resetCRCWarnings
, addBadSource
, getBadSourcesList
, isBadSource
, darcsdir
, darcsLastMessage
, darcsSendMessage
, darcsSendMessageFinal
, defaultRemoteDarcsCmd
, isReachableSource
, addReachableSource
) where
import Prelude ()
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 :: IORef Bool
_debugMode = IO (IORef Bool) -> IORef Bool
forall a. IO a -> a
unsafePerformIO (IO (IORef Bool) -> IORef Bool) -> IO (IORef Bool) -> IORef Bool
forall a b. (a -> b) -> a -> b
$ Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
{-# NOINLINE _debugMode #-}
setDebugMode :: IO ()
setDebugMode :: IO ()
setDebugMode = IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
_debugMode Bool
True
whenDebugMode :: IO () -> IO ()
whenDebugMode :: IO () -> IO ()
whenDebugMode j :: IO ()
j = do Bool
b <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
_debugMode
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b IO ()
j
withDebugMode :: (Bool -> IO a) -> IO a
withDebugMode :: (Bool -> IO a) -> IO a
withDebugMode j :: Bool -> IO a
j = IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
_debugMode IO Bool -> (Bool -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> IO a
j
debugMessage :: String -> IO ()
debugMessage :: String -> IO ()
debugMessage m :: String
m = IO () -> IO ()
whenDebugMode (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do IO ()
putTiming; Handle -> String -> IO ()
hPutStrLn Handle
stderr String
m
debugFail :: String -> IO a
debugFail :: String -> IO a
debugFail m :: String
m = String -> IO ()
debugMessage String
m IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
m
putTiming :: IO ()
putTiming :: IO ()
putTiming = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
timingsMode (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
CalendarTime
t <- IO ClockTime
getClockTime IO ClockTime -> (ClockTime -> IO CalendarTime) -> IO CalendarTime
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ClockTime -> IO CalendarTime
toCalendarTime
Handle -> String -> IO ()
hPutStr Handle
stderr (CalendarTime -> String
calendarTimeToString CalendarTime
tString -> String -> String
forall a. [a] -> [a] -> [a]
++": ")
_timingsMode :: IORef Bool
_timingsMode :: IORef Bool
_timingsMode = IO (IORef Bool) -> IORef Bool
forall a. IO a -> a
unsafePerformIO (IO (IORef Bool) -> IORef Bool) -> IO (IORef Bool) -> IORef Bool
forall a b. (a -> b) -> a -> b
$ Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
{-# NOINLINE _timingsMode #-}
setTimingsMode :: IO ()
setTimingsMode :: IO ()
setTimingsMode = IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
_timingsMode Bool
True
timingsMode :: Bool
timingsMode :: Bool
timingsMode = IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
_timingsMode
{-# NOINLINE timingsMode #-}
type CRCWarningList = [FilePath]
_crcWarningList :: IORef CRCWarningList
_crcWarningList :: IORef CRCWarningList
_crcWarningList = IO (IORef CRCWarningList) -> IORef CRCWarningList
forall a. IO a -> a
unsafePerformIO (IO (IORef CRCWarningList) -> IORef CRCWarningList)
-> IO (IORef CRCWarningList) -> IORef CRCWarningList
forall a b. (a -> b) -> a -> b
$ CRCWarningList -> IO (IORef CRCWarningList)
forall a. a -> IO (IORef a)
newIORef []
{-# NOINLINE _crcWarningList #-}
addCRCWarning :: FilePath -> IO ()
addCRCWarning :: String -> IO ()
addCRCWarning fp :: String
fp = IORef CRCWarningList -> (CRCWarningList -> CRCWarningList) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef CRCWarningList
_crcWarningList (String
fpString -> CRCWarningList -> CRCWarningList
forall a. a -> [a] -> [a]
:)
getCRCWarnings :: IO [FilePath]
getCRCWarnings :: IO CRCWarningList
getCRCWarnings = IORef CRCWarningList -> IO CRCWarningList
forall a. IORef a -> IO a
readIORef IORef CRCWarningList
_crcWarningList
resetCRCWarnings :: IO ()
resetCRCWarnings :: IO ()
resetCRCWarnings = IORef CRCWarningList -> CRCWarningList -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef CRCWarningList
_crcWarningList []
_badSourcesList :: IORef [String]
_badSourcesList :: IORef CRCWarningList
_badSourcesList = IO (IORef CRCWarningList) -> IORef CRCWarningList
forall a. IO a -> a
unsafePerformIO (IO (IORef CRCWarningList) -> IORef CRCWarningList)
-> IO (IORef CRCWarningList) -> IORef CRCWarningList
forall a b. (a -> b) -> a -> b
$ CRCWarningList -> IO (IORef CRCWarningList)
forall a. a -> IO (IORef a)
newIORef []
{-# NOINLINE _badSourcesList #-}
addBadSource :: String -> IO ()
addBadSource :: String -> IO ()
addBadSource cache :: String
cache = IORef CRCWarningList -> (CRCWarningList -> CRCWarningList) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef CRCWarningList
_badSourcesList (String
cacheString -> CRCWarningList -> CRCWarningList
forall a. a -> [a] -> [a]
:)
getBadSourcesList :: IO [String]
getBadSourcesList :: IO CRCWarningList
getBadSourcesList = IORef CRCWarningList -> IO CRCWarningList
forall a. IORef a -> IO a
readIORef IORef CRCWarningList
_badSourcesList
isBadSource :: IO (String -> Bool)
isBadSource :: IO (String -> Bool)
isBadSource = do
CRCWarningList
badSources <- IO CRCWarningList
getBadSourcesList
(String -> Bool) -> IO (String -> Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> CRCWarningList -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` CRCWarningList
badSources)
_reachableSourcesList :: IORef [String]
_reachableSourcesList :: IORef CRCWarningList
_reachableSourcesList = IO (IORef CRCWarningList) -> IORef CRCWarningList
forall a. IO a -> a
unsafePerformIO (IO (IORef CRCWarningList) -> IORef CRCWarningList)
-> IO (IORef CRCWarningList) -> IORef CRCWarningList
forall a b. (a -> b) -> a -> b
$ CRCWarningList -> IO (IORef CRCWarningList)
forall a. a -> IO (IORef a)
newIORef []
{-# NOINLINE _reachableSourcesList #-}
addReachableSource :: String -> IO ()
addReachableSource :: String -> IO ()
addReachableSource src :: String
src = IORef CRCWarningList -> (CRCWarningList -> CRCWarningList) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef CRCWarningList
_reachableSourcesList (String
srcString -> CRCWarningList -> CRCWarningList
forall a. a -> [a] -> [a]
:)
getReachableSources :: IO [String]
getReachableSources :: IO CRCWarningList
getReachableSources = IORef CRCWarningList -> IO CRCWarningList
forall a. IORef a -> IO a
readIORef IORef CRCWarningList
_reachableSourcesList
isReachableSource :: IO (String -> Bool)
isReachableSource :: IO (String -> Bool)
isReachableSource = do
CRCWarningList
reachableSources <- IO CRCWarningList
getReachableSources
(String -> Bool) -> IO (String -> Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> CRCWarningList -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` CRCWarningList
reachableSources)
darcsdir :: String
darcsdir :: String
darcsdir = "_darcs"
defaultRemoteDarcsCmd :: String
defaultRemoteDarcsCmd :: String
defaultRemoteDarcsCmd = "darcs"
darcsLastMessage :: String
darcsLastMessage :: String
darcsLastMessage = String -> String -> String
combine String
darcsdir "patch_description.txt"
darcsSendMessage :: String
darcsSendMessage :: String
darcsSendMessage = String -> String -> String
combine String
darcsdir "darcs-send"
darcsSendMessageFinal :: String
darcsSendMessageFinal :: String
darcsSendMessageFinal = String
darcsSendMessage String -> String -> String
<.> "final"