logging 3.0.5 → 3.0.6
raw patch · 4 files changed
+75/−75 lines, 4 files
Files
- Control/Logging.hs +23/−23
- logging.cabal +3/−3
- test/Main.hs +49/−0
- test/main.hs +0/−49
Control/Logging.hs view
@@ -1,4 +1,5 @@ {-# OPTIONS_GHC -Wall -fno-warn-orphans #-}+{-# LANGUAGE OverloadedStrings #-} -- | Quick example of how to use this module: --@@ -71,10 +72,8 @@ import Data.Maybe (isJust) import Data.Monoid import Data.Text as T-import Data.Text.Encoding as T import Data.Time import Data.Time.Locale.Compat (defaultTimeLocale)-import Debug.Trace import Prelude hiding (log) import System.IO.Unsafe import System.Log.FastLogger@@ -101,7 +100,7 @@ logTimeFormat :: IORef String {-# NOINLINE logTimeFormat #-}-logTimeFormat = unsafePerformIO $ newIORef "%T"+logTimeFormat = unsafePerformIO $ newIORef "%F %T" -- | Set the format used for log timestamps. setLogTimeFormat :: String -> IO ()@@ -130,7 +129,7 @@ Nothing -> True Just re -> lvl /= LevelDebug || isJust (matchRegex re (T.unpack src)) when willLog $ do- now <- getCurrentTime+ now <- getZonedTime fmt <- readIORef logTimeFormat let stamp = formatTime defaultTimeLocale fmt now set <- readIORef logSet@@ -243,37 +242,37 @@ error (unsafePerformIO (logError src str >> flushLog) `seq` unpack str) traceL :: Text -> a -> a-traceL str = trace (unsafePerformIO (debug str) `seq` unpack str)+traceL str x = unsafePerformIO (debug str) `seq` x traceL' :: Text -> a -> a-traceL' str = trace (unsafePerformIO (debug str >> flushLog) `seq` unpack str)+traceL' str x = unsafePerformIO (debug str >> flushLog) `seq` x traceSL :: Text -> Text -> a -> a-traceSL src str = trace (unsafePerformIO (debugS src str) `seq` unpack str)+traceSL src str x = unsafePerformIO (debugS src str) `seq` x traceSL' :: Text -> Text -> a -> a-traceSL' src str =- trace (unsafePerformIO (debugS src str >> flushLog) `seq` unpack str)+traceSL' src str x =+ unsafePerformIO (debugS src str >> flushLog) `seq` x -traceShowL :: Show a => a -> a1 -> a1+traceShowL :: Show a => a -> a traceShowL x =- let s = show x- in trace (unsafePerformIO (debug (pack s)) `seq` s)+ let s = Prelude.show x+ in unsafePerformIO (debug (pack s)) `seq` x -traceShowL' :: Show a => a -> a1 -> a1+traceShowL' :: Show a => a -> a traceShowL' x =- let s = show x- in trace (unsafePerformIO (debug (pack s) >> flushLog) `seq` s)+ let s = Prelude.show x+ in unsafePerformIO (debug (pack s) >> flushLog) `seq` x -traceShowSL :: Show a => Text -> a -> a1 -> a1+traceShowSL :: Show a => Text -> a -> a traceShowSL src x =- let s = show x- in trace (unsafePerformIO (debugS src (pack s)) `seq` s)+ let s = Prelude.show x+ in unsafePerformIO (debugS src (pack s)) `seq` x -traceShowSL' :: Show a => Text -> a -> a1 -> a1+traceShowSL' :: Show a => Text -> a -> a traceShowSL' src x =- let s = show x- in trace (unsafePerformIO (debugS src (pack s) >> flushLog) `seq` s)+ let s = Prelude.show x+ in unsafePerformIO (debugS src (pack s) >> flushLog) `seq` x doTimedLog :: (MonadBaseControl IO m, MonadIO m) => (Text -> IO ()) -> Bool -> Text -> m a -> m a@@ -281,7 +280,7 @@ start <- liftIO getCurrentTime when wrapped $ (liftIO . logf) $ msg <> "..." res <- f `catch` \e -> do- let str = show (e :: SomeException)+ let str = Prelude.show (e :: SomeException) wrapup start $ pack $ if wrapped then "...FAIL (" ++ str ++ ")"@@ -292,7 +291,8 @@ where wrapup start m = do end <- liftIO getCurrentTime- liftIO . logf $ msg <> m <> " [" <> pack (show (diffUTCTime end start)) <> "]"+ liftIO . logf $+ msg <> m <> " [" <> pack (Prelude.show (diffUTCTime end start)) <> "]" -- | Output a logging message both before an action begins, and after it ends, -- reporting the total length of time. If an exception occurred, it is also
logging.cabal view
@@ -1,5 +1,5 @@ Name: logging-Version: 3.0.5+Version: 3.0.6 Synopsis: Simplified logging in IO for application writers. License-file: LICENSE License: MIT@@ -53,12 +53,12 @@ default-extensions: BangPatterns FlexibleContexts- OverloadedStrings+ -- OverloadedStrings test-suite test hs-source-dirs: test default-language: Haskell2010- main-is: main.hs+ main-is: Main.hs type: exitcode-stdio-1.0 ghc-options: -Wall -threaded build-depends:
+ test/Main.hs view
@@ -0,0 +1,49 @@+module Main where++import Control.Concurrent+import Control.Exception+import Control.Logging+import Prelude hiding (log)+import Test.Hspec++tryAny :: IO a -> IO (Either SomeException a)+tryAny = try++main :: IO ()+main = hspec $++ describe "simple logging" $ do++ it "logs output" $ withStdoutLogging $ do+ log "Hello, world!"+ warnS "test-suite" "you've been warned"+ timedLog "Did a good thing" $ threadDelay 100000+ _ <- tryAny $ timedLog "Did a bad thing" $+ threadDelay 100000 >> error "foo"+ _ <- tryAny $ errorL "Uh oh"+ return ()++ it "supports setting log levels" $ do+ setLogLevel LevelWarn++ withStdoutLogging $ do+ debugS "Set LogLevel test" "This is an unshown debug message"+ logS "Set LogLevel test" "This is an unshown info message"+ warnS "Set LogLevel test" "This is a shown info message"+ _ <- tryAny $ errorSL "Set LogLevel test" "This is a shown error message"+ return ()++ -- setting the log level back to debug so that following tests run+ setLogLevel LevelDebug++ it "supports using debug classes" $ do+ setDebugSourceRegex "(foo\\.|baaz).*"+ withStdoutLogging $ do+ 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"
− test/main.hs
@@ -1,49 +0,0 @@-module Main where--import Control.Concurrent-import Control.Exception-import Control.Logging-import Prelude hiding (log)-import Test.Hspec--tryAny :: IO a -> IO (Either SomeException a)-tryAny = try--main :: IO ()-main = hspec $-- describe "simple logging" $ do-- it "logs output" $ withStdoutLogging $ do- log "Hello, world!"- warnS "test-suite" "you've been warned"- timedLog "Did a good thing" $ threadDelay 100000- _ <- tryAny $ timedLog "Did a bad thing" $- threadDelay 100000 >> error "foo"- _ <- tryAny $ errorL "Uh oh"- return ()-- it "supports setting log levels" $ do- setLogLevel LevelWarn-- withStdoutLogging $ do- debugS "Set LogLevel test" "This is an unshown debug message"- logS "Set LogLevel test" "This is an unshown info message"- warnS "Set LogLevel test" "This is a shown info message"- _ <- tryAny $ errorSL "Set LogLevel test" "This is a shown error message"- return ()-- -- setting the log level back to debug so that following tests run- setLogLevel LevelDebug-- it "supports using debug classes" $ do- setDebugSourceRegex "(foo\\.|baaz).*"- withStdoutLogging $ do- 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"