1-- Copyright (C) 2005 Tomasz Zielonka
2--
3-- This program is free software; you can redistribute it and/or modify
4-- it under the terms of the GNU General Public License as published by
5-- the Free Software Foundation; either version 2, or (at your option)
6-- any later version.
7--
8-- This program is distributed in the hope that it will be useful,
9-- but WITHOUT ANY WARRANTY; without even the implied warranty of
10-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
11-- GNU General Public License for more details.
12--
13-- You should have received a copy of the GNU General Public License
14-- along with this program; see the file COPYING.  If not, write to
15-- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
16-- Boston, MA 02110-1301, USA.
17
18-- |
19-- Module      : Darcs.Util.Global
20-- Copyright   : 2005 Tomasz Zielonka
21-- License     : GPL
22-- Maintainer  : darcs-devel@darcs.net
23-- Stability   : experimental
24-- Portability : portable
25--
26-- This was originally Tomasz Zielonka's AtExit module, slightly generalised
27-- to include global variables.  Here, we attempt to cover broad, global
28-- features, such as exit handlers.  These features slightly break the Haskellian
29-- purity of darcs, in favour of programming convenience.
30
31module Darcs.Util.Global
32    (
33      timingsMode
34    , setTimingsMode
35    , whenDebugMode
36    , withDebugMode
37    , setDebugMode
38    , debugMessage
39    , putTiming
40    , addCRCWarning
41    , getCRCWarnings
42    , resetCRCWarnings
43    , darcsdir
44    , darcsLastMessage
45    , darcsSendMessage
46    , darcsSendMessageFinal
47    , defaultRemoteDarcsCmd
48    ) where
49
50
51import Darcs.Prelude
52
53import Control.Monad ( when )
54import Data.IORef ( modifyIORef, IORef, newIORef, readIORef, writeIORef )
55import System.IO.Unsafe (unsafePerformIO)
56import System.IO ( hPutStrLn, hPutStr, stderr )
57import System.Time ( calendarTimeToString, toCalendarTime, getClockTime )
58import System.FilePath.Posix ( combine, (<.>) )
59
60
61-- Write-once-read-many global variables make it easier to implement flags, such
62-- as --no-ssh-cm. Using global variables reduces the number of parameters that
63-- we have to pass around, but it is rather unsafe and should be used sparingly.
64
65
66_debugMode :: IORef Bool
67_debugMode = unsafePerformIO $ newIORef False
68{-# NOINLINE _debugMode #-}
69
70
71setDebugMode :: IO ()
72setDebugMode = writeIORef _debugMode True
73
74
75whenDebugMode :: IO () -> IO ()
76whenDebugMode j = do b <- readIORef _debugMode
77                     when b j
78
79
80withDebugMode :: (Bool -> IO a) -> IO a
81withDebugMode j = readIORef _debugMode >>= j
82
83
84debugMessage :: String -> IO ()
85debugMessage m = whenDebugMode $ do putTiming; hPutStrLn stderr m
86
87
88putTiming :: IO ()
89putTiming = when timingsMode $ do
90    t <- getClockTime >>= toCalendarTime
91    hPutStr stderr (calendarTimeToString t++": ")
92
93
94_timingsMode :: IORef Bool
95_timingsMode = unsafePerformIO $ newIORef False
96{-# NOINLINE _timingsMode #-}
97
98
99setTimingsMode :: IO ()
100setTimingsMode = writeIORef _timingsMode True
101
102
103timingsMode :: Bool
104timingsMode = unsafePerformIO $ readIORef _timingsMode
105{-# NOINLINE timingsMode #-}
106
107
108type CRCWarningList = [FilePath]
109_crcWarningList :: IORef CRCWarningList
110_crcWarningList = unsafePerformIO $ newIORef []
111{-# NOINLINE _crcWarningList #-}
112
113
114addCRCWarning :: FilePath -> IO ()
115addCRCWarning fp = modifyIORef _crcWarningList (fp:)
116
117
118getCRCWarnings :: IO [FilePath]
119getCRCWarnings = readIORef _crcWarningList
120
121
122resetCRCWarnings :: IO ()
123resetCRCWarnings = writeIORef _crcWarningList []
124
125
126darcsdir :: String
127darcsdir = "_darcs"
128
129defaultRemoteDarcsCmd :: String
130defaultRemoteDarcsCmd = "darcs"
131
132darcsLastMessage :: String
133darcsLastMessage = combine darcsdir "patch_description.txt"
134
135darcsSendMessage :: String
136darcsSendMessage = combine darcsdir "darcs-send"
137
138darcsSendMessageFinal :: String
139darcsSendMessageFinal = darcsSendMessage <.> "final"
140