diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/DPut.hs | 23 |
1 files changed, 12 insertions, 11 deletions
diff --git a/src/DPut.hs b/src/DPut.hs index dc699e76..3cb31160 100644 --- a/src/DPut.hs +++ b/src/DPut.hs | |||
@@ -5,24 +5,25 @@ import qualified Data.Map.Strict as Map | |||
5 | import System.IO (stderr,hPutStrLn) | 5 | import System.IO (stderr,hPutStrLn) |
6 | import Data.Maybe | 6 | import Data.Maybe |
7 | import System.IO.Unsafe (unsafePerformIO) | 7 | import System.IO.Unsafe (unsafePerformIO) |
8 | import System.Log.Logger | ||
8 | 9 | ||
9 | data DebugTag = XAnnounce | XDHT | XOnion | XNetCrypto | XPing | XLan | XMisc | 10 | data DebugTag = XAnnounce | XDHT | XOnion | XNetCrypto | XPing | XLan | XMisc |
10 | deriving (Eq,Ord,Show,Read,Enum,Bounded) | 11 | deriving (Eq,Ord,Show,Read,Enum,Bounded) |
11 | 12 | ||
12 | {-# NOINLINE verbosityMap #-} | 13 | appName :: String |
13 | verbosityMap :: TVar (Map.Map DebugTag Bool) | 14 | appName = "toxmpp" |
14 | verbosityMap = unsafePerformIO $ newTVarIO (Map.empty) | 15 | |
16 | (<.>) :: String -> String -> String | ||
17 | a <.> b = a ++ "." ++ b | ||
15 | 18 | ||
16 | dput :: DebugTag -> String -> IO () | 19 | dput :: DebugTag -> String -> IO () |
17 | dput tag msg | 20 | dput tag msg = debugM (appName <.> show tag) msg |
18 | = do | 21 | |
19 | mp <- atomically $ readTVar verbosityMap | 22 | setTagLevel :: Priority -> DebugTag -> IO () |
20 | if fromMaybe True (Map.lookup tag mp) | 23 | setTagLevel level tag = updateGlobalLogger (appName <.> show tag) (setLevel level) |
21 | then System.IO.hPutStrLn stderr msg | ||
22 | else return () | ||
23 | 24 | ||
24 | setQuiet :: DebugTag -> IO () | 25 | setQuiet :: DebugTag -> IO () |
25 | setQuiet tag = atomically $ modifyTVar' (verbosityMap) (Map.insert tag False) | 26 | setQuiet = setTagLevel WARNING |
26 | 27 | ||
27 | setVerbose :: DebugTag -> IO () | 28 | setVerbose :: DebugTag -> IO () |
28 | setVerbose tag = atomically $ modifyTVar' (verbosityMap) (Map.insert tag True) | 29 | setVerbose = setTagLevel DEBUG |