-- 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.Global
-- 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.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, (<.>) )


-- Write-once-read-many global variables make it easier to implement flags, such
-- as --no-ssh-cm. Using global variables reduces the number of parameters that
-- we have to pass around, but it is rather unsafe and should be used sparingly.


_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 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 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 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


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]
++String
": ")


_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 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 []


darcsdir :: String
darcsdir :: String
darcsdir = String
"_darcs"

defaultRemoteDarcsCmd :: String
defaultRemoteDarcsCmd :: String
defaultRemoteDarcsCmd = String
"darcs"

darcsLastMessage :: String
darcsLastMessage :: String
darcsLastMessage = String -> String -> String
combine String
darcsdir String
"patch_description.txt"

darcsSendMessage :: String 
darcsSendMessage :: String
darcsSendMessage = String -> String -> String
combine String
darcsdir String
"darcs-send"

darcsSendMessageFinal :: String
darcsSendMessageFinal :: String
darcsSendMessageFinal = String
darcsSendMessage String -> String -> String
<.> String
"final"