diff options
author | James Crayne <jim.crayne@gmail.com> | 2018-05-29 03:37:28 +0000 |
---|---|---|
committer | James Crayne <jim.crayne@gmail.com> | 2018-05-29 03:37:28 +0000 |
commit | be48775177ac1d22f868b252b9517354f69a452d (patch) | |
tree | c3768414e88c61d013c53866f33bf46efa0aebec /src | |
parent | 1c65905502df013ab0076726aa919b91c14d7a4c (diff) |
oops, left out new module in last commit
Diffstat (limited to 'src')
-rw-r--r-- | src/DPut.hs | 28 |
1 files changed, 28 insertions, 0 deletions
diff --git a/src/DPut.hs b/src/DPut.hs new file mode 100644 index 00000000..abf926b5 --- /dev/null +++ b/src/DPut.hs | |||
@@ -0,0 +1,28 @@ | |||
1 | module DPut where | ||
2 | |||
3 | import Control.Concurrent.STM | ||
4 | import qualified Data.Map.Strict as Map | ||
5 | import System.IO (stderr,hPutStrLn) | ||
6 | import Data.Maybe | ||
7 | import System.IO.Unsafe (unsafePerformIO) | ||
8 | |||
9 | data DebugTag = XAnnounce | XDHT | XOnion | XNetCrypto | XMisc | ||
10 | deriving (Eq,Ord,Show,Read) | ||
11 | |||
12 | {-# NOINLINE verbosityMap #-} | ||
13 | verbosityMap :: TVar (Map.Map DebugTag Bool) | ||
14 | verbosityMap = unsafePerformIO $ newTVarIO (Map.empty) | ||
15 | |||
16 | dput :: DebugTag -> String -> IO () | ||
17 | dput tag msg | ||
18 | = do | ||
19 | mp <- atomically $ readTVar verbosityMap | ||
20 | if fromMaybe True (Map.lookup tag mp) | ||
21 | then System.IO.hPutStrLn stderr msg | ||
22 | else return () | ||
23 | |||
24 | setQuiet :: DebugTag -> IO () | ||
25 | setQuiet tag = atomically $ modifyTVar' (verbosityMap) (Map.insert tag False) | ||
26 | |||
27 | setVerbose :: DebugTag -> IO () | ||
28 | setVerbose tag = atomically $ modifyTVar' (verbosityMap) (Map.insert tag True) | ||