module DPut where import Control.Monad.IO.Class import Control.Concurrent.STM import qualified Data.Map.Strict as Map import System.IO (stderr,hPutStrLn) import Data.Maybe import System.IO.Unsafe (unsafePerformIO) import System.Log.Logger import qualified Data.ByteString.Char8 as B import qualified Data.Text as T import qualified Data.Text.Encoding as T -- | Debug Tags, add more as needed, but ensure XAnnounce is always first, XMisc last data DebugTag = XAnnounce | XBitTorrent | XDHT | XLan | XMan | XNetCrypto | XOnion | XRoutes | XPing | XRefresh | XJabber | XMisc deriving (Eq,Ord,Show,Read,Enum,Bounded) appName :: String appName = "toxmpp" (<.>) :: String -> String -> String a <.> b = a ++ "." ++ b dput :: MonadIO m => DebugTag -> String -> m () dput tag msg = liftIO $ debugM (appName <.> show tag) msg dputB :: MonadIO m => DebugTag -> B.ByteString -> m () dputB tag msg = liftIO $ debugM (appName <.> show tag) (T.unpack . T.decodeUtf8 $ msg) -- | Trace version of 'dput' works in arbitrary monad, using unsafePerformIO. tput :: Applicative m => DebugTag -> String -> m () tput tag msg = (unsafePerformIO $ dput tag msg) `seq` pure () -- | like 'trace' but parameterized with 'DebugTag' dtrace :: DebugTag -> String -> a -> a dtrace tag msg result = (unsafePerformIO $ dput tag msg) `seq` result setTagLevel :: Priority -> DebugTag -> IO () setTagLevel level tag = updateGlobalLogger (appName <.> show tag) (setLevel level) setQuiet :: DebugTag -> IO () setQuiet = setTagLevel WARNING setVerbose :: DebugTag -> IO () setVerbose = setTagLevel DEBUG getVerbose tag = do logger <- getLogger (appName <.> show tag) case getLevel logger of Just p | p <= DEBUG -> return True _ -> return False