logging 3.0.2 → 3.0.3

raw patch · 3 files changed

+27/−19 lines, 3 filesdep +regex-compatdep −pcre-light

Dependencies added: regex-compat

Dependencies removed: pcre-light

Files

• Control/Logging.hs +15/−13
• logging.cabal +2/−2
• test/main.hs +10/−4

@@ -78,7 +78,7 @@ import Prelude hiding (log) import System.IO.Unsafe import System.Log.FastLogger-import Text.Regex.PCRE.Light+import Text.Regex (Regex, mkRegex, matchRegex)  data LogLevel = LevelDebug | LevelInfo | LevelWarn | LevelError | LevelOther Text     deriving (Eq, Prelude.Show, Prelude.Read, Ord)@@ -101,7 +101,7 @@  logTimeFormat :: IORef String {-# NOINLINE logTimeFormat #-}-logTimeFormat = unsafePerformIO $ newIORef "%Y %b-%d %H:%M:%S%Q"+logTimeFormat = unsafePerformIO $ newIORef "%Y %b-%d %H:%M:%S%q"  -- | Set the format used for log timestamps. setLogTimeFormat :: String -> IO ()@@ -118,10 +118,9 @@ setDebugSourceRegex =     atomicWriteIORef debugSourceRegexp         . Just-        . flip compile []-        . encodeUtf8-        . T.pack+        . mkRegex + loggingLogger :: ToLogStr msg => LogLevel -> LogSource -> msg -> IO () loggingLogger !lvl !src str = do     maxLvl <- readIORef logLevel@@ -129,11 +128,14 @@         mre <- readIORef debugSourceRegexp         let willLog = case mre of                 Nothing -> True-                Just re -> isJust (match re (encodeUtf8 src) [])+                Just re -> lvl /= LevelDebug || isJust (matchRegex re (T.unpack src))         when willLog $ do             now <- getCurrentTime             fmt <- readIORef logTimeFormat-            let stamp = formatTime defaultTimeLocale fmt now+            let stamp' = formatTime defaultTimeLocale fmt now+                -- stripping off the typically all-0 end of the 12-digit+                -- picosecond section of the `formatTime` output+                stamp = Prelude.take (Prelude.length stamp' - 6) stamp'             set <- readIORef logSet             pushLogStr set                 $ toLogStr (stamp ++ " " ++ renderLevel lvl@@ -199,10 +201,10 @@ -- | The apostrophe varients of the logging functions flush the log after each --   message. log' :: MonadIO m => Text -> m ()-log' msg = (liftIO $ log msg) >> flushLog+log' msg = liftIO (log msg) >> flushLog  logS' :: MonadIO m => Text -> Text -> m ()-logS' src msg = (liftIO $ logS src msg) >> flushLog+logS' src msg = liftIO (logS src msg) >> flushLog  debug :: Text -> IO () debug = debugS ""@@ -211,10 +213,10 @@ debugS = loggingLogger LevelDebug  debug' :: MonadIO m => Text -> m ()-debug' msg = (liftIO $ debug msg) >> flushLog+debug' msg = liftIO (debug msg) >> flushLog  debugS' :: MonadIO m => Text -> Text -> m ()-debugS' src msg = (liftIO $ debugS src msg) >> flushLog+debugS' src msg = liftIO (debugS src msg) >> flushLog  warn :: Text -> IO () warn = warnS ""@@ -223,10 +225,10 @@ warnS = loggingLogger LevelWarn  warn' :: MonadIO m => Text -> m ()-warn' msg = (liftIO $ warn msg) >> flushLog+warn' msg = liftIO (warn msg) >> flushLog  warnS' :: MonadIO m => Text -> Text -> m ()-warnS' src msg = (liftIO $ warnS src msg) >> flushLog+warnS' src msg = liftIO (warnS src msg) >> flushLog  -- | A logging variant of 'error' which uses 'unsafePerformIO' to output a log --   message before calling 'error'.

@@ -1,5 +1,5 @@ Name:                logging-Version:             3.0.2+Version:             3.0.3 Synopsis:            Simplified logging in IO for application writers. License-file:        LICENSE License:             MIT@@ -47,7 +47,7 @@       , time-locale-compat   >= 0.1.1.0       , transformers         >= 0.3.0.0       , lifted-base          >= 0.2.2.0-      , pcre-light           >= 0.4+      , regex-compat         >= 0.95.1     exposed-modules:         Control.Logging     default-extensions:

@@ -10,7 +10,7 @@ tryAny = try  main :: IO ()-main = hspec $ do+main = hspec $      describe "simple logging" $ do @@ -37,7 +37,13 @@              setLogLevel LevelDebug          it "supports using debug classes" $ do-            setDebugSourceRegex "foo\\..*"+            setDebugSourceRegex "(foo\\.|baaz).*"             withStdoutLogging $ do-                debugS "foo" "This is a foo message"-                debugS "foo.bar" "This is a foo.bar message"+                debugS "foo" "This is an unshown debug message"+                debugS "foo.bar" "This is a shown debug message"+                debugS "baaz.quux" "This is a shown debug message"+                debugS "baaz" "This is a shown debug message"+                -- checking that non-debug messages aren't filtered+                logS "bar" "This is a shown log message"+                logS "foo.bar" "This is a shown log message"+                warnS "foo" "This is a shown warn message"