From c0910442bb7258398a6717400c1054aa177faca1 Mon Sep 17 00:00:00 2001 From: James Crayne Date: Sun, 4 Nov 2018 03:43:33 -0500 Subject: Moved DPut module to separate library --- dht-client.cabal | 11 +++++---- src/DPut.hs | 75 -------------------------------------------------------- 2 files changed, 6 insertions(+), 80 deletions(-) delete mode 100644 src/DPut.hs diff --git a/dht-client.cabal b/dht-client.cabal index 38f4b8c6..91171084 100644 --- a/dht-client.cabal +++ b/dht-client.cabal @@ -69,8 +69,7 @@ library , RecordWildCards , NondecreasingIndentation hs-source-dirs: src, ., Presence - exposed-modules: DPut - DebugTag + exposed-modules: DebugTag Network.SocketLike Data.Digest.CRC32C Data.Bits.ByteString @@ -155,6 +154,7 @@ library Network.Tox.Session build-depends: base + , dput-hslogger , containers , dependent-sum , array @@ -267,21 +267,21 @@ executable avahi hs-source-dirs: examples main-is: avahi.hs default-language: Haskell2010 - build-depends: base-prelude, dht-client, avahi, network + build-depends: base-prelude, dht-client, avahi, network, dput-hslogger ghc-options: -fobject-code executable dht hs-source-dirs: examples main-is: dht.hs default-language: Haskell2010 - build-depends: base, haskeline, network, bytestring, transformers + build-depends: base, haskeline, network, bytestring, transformers, dput-hslogger ghc-options: -fobject-code executable dhtd hs-source-dirs: examples main-is: dhtd.hs default-language: Haskell2010 - build-depends: base, network, bytestring, hashable, deepseq + build-depends: base, network, bytestring, hashable, deepseq, dput-hslogger , aeson , array , pretty @@ -324,6 +324,7 @@ executable testTox main-is: testTox.hs default-language: Haskell2010 build-depends: base + , dput-hslogger , dht-client , stm , stm-chans diff --git a/src/DPut.hs b/src/DPut.hs deleted file mode 100644 index 38e532d0..00000000 --- a/src/DPut.hs +++ /dev/null @@ -1,75 +0,0 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE ScopedTypeVariables #-} -module DPut where - -import Control.Monad.IO.Class -import qualified Data.Map.Strict as Map -import Data.Maybe -import Data.IORef -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 -import Debug.Trace -import Data.Typeable -import Data.Dynamic - -type IsDebugTag t = (Eq t, Ord t, Show t, Read t, Enum t, Bounded t,Typeable t) - -appName :: String -appName = "toxmpp" - -(<.>) :: String -> String -> String -a <.> b = a ++ "." ++ b - -dput :: (MonadIO m, IsDebugTag tag) => tag -> String -> m () -dput tag msg = liftIO $ debugM (appName <.> show tag) msg - -dputB :: (MonadIO m, IsDebugTag tag) => tag -> B.ByteString -> m () -dputB tag msg = liftIO $ debugM (appName <.> show tag) (T.unpack . T.decodeUtf8 $ msg) - -{-# NOINLINE verbosityMap #-} -verbosityMap :: IORef (Map.Map TypeRep Dynamic) -verbosityMap = unsafePerformIO $ newIORef (Map.empty) - --- | Trace version of 'dput' works in arbitrary monad, using unsafePerformIO. -tput :: (Applicative m, IsDebugTag tag) => tag -> String -> m () -tput tag msg = - let mp = unsafePerformIO $ readIORef verbosityMap - in if maybe True (fromMaybe True . Map.lookup tag . flip fromDyn Map.empty) (Map.lookup (typeOf tag) mp) - then trace msg (pure ()) - else pure () - --- | like 'trace' but parameterized with 'DebugTag' -dtrace :: forall a tag. IsDebugTag tag => tag -> String -> a -> a -dtrace tag msg result = let mp = unsafePerformIO $ readIORef verbosityMap - mp' :: Map.Map tag Bool - mp' = maybe Map.empty (flip fromDyn Map.empty) (Map.lookup (typeOf tag) mp) - in if fromMaybe True (Map.lookup tag mp') - then trace msg result - else result - -setTagLevel :: forall tag. IsDebugTag tag => Priority -> tag -> IO () -setTagLevel level tag = do - updateGlobalLogger (appName <.> show tag) (setLevel level) - modifyIORef verbosityMap $ \mpByType -> do - case Map.lookup (typeOf tag) mpByType of - Nothing -> Map.insert (typeOf tag) (toDyn $ Map.fromList [(tag,(level <= DEBUG))]) mpByType - Just dyn -> let mpByTag :: Map.Map tag Bool - mpByTag = fromDyn dyn Map.empty - in Map.insert (typeOf tag) (toDyn $ Map.insert tag (level <= DEBUG) mpByTag) mpByType - -setQuiet :: forall tag. IsDebugTag tag => tag -> IO () -setQuiet = setTagLevel WARNING - -setVerbose :: forall tag. IsDebugTag tag => tag -> IO () -setVerbose = setTagLevel DEBUG - -getVerbose :: forall tag. IsDebugTag tag => tag -> IO Bool -getVerbose tag = do - logger <- getLogger (appName <.> show tag) - case getLevel logger of - Just p | p <= DEBUG -> return True - _ -> return False - -- cgit v1.2.3