yet-another-logger 0.2.1 → 0.2.2
raw patch · 10 files changed
+179/−26 lines, 10 files
Files
- CHANGELOG.md +12/−0
- constraints +14/−14
- src/System/Logger.hs +5/−0
- src/System/Logger/Backend/ColorOption.hs +5/−0
- src/System/Logger/Backend/Handle.hs +47/−5
- src/System/Logger/Internal.hs +9/−1
- src/System/Logger/Logger/Internal.hs +19/−0
- src/System/Logger/Types.hs +57/−2
- test/TastyTools.hs +9/−2
- yet-another-logger.cabal +2/−2
CHANGELOG.md view
@@ -1,3 +1,15 @@+0.2.2+=====++* [Issue #28] Generalized type of lens `logMsg` to support changing+ the message type.++* [Issue #29] Fixed precision of `formatIso8601` function.++* [Issue #30] Added a version of `withHandleBackend` that is generic+ in the log message type and accept a formatting function for+ formatting the log message as text.+ 0.2.1 =====
constraints view
@@ -1,5 +1,5 @@-constraints: Cabal ==1.22.2.0,- MonadRandom ==0.3.0.1,+constraints: Cabal ==1.22.3.0,+ MonadRandom ==0.3.0.2, StateVar ==1.1.0.0, adjunctions ==4.2, aeson ==0.8.0.2,@@ -10,12 +10,12 @@ asn1-parse ==0.9.0, asn1-types ==0.3.0, async ==2.0.2,- attoparsec ==0.12.1.5,+ attoparsec ==0.12.1.6, base ==4.8.0.0, base-unicode-symbols ==0.2.2.4, base64-bytestring ==1.0.0.1, bifunctors ==4.2.1,- binary ==0.7.3.0,+ binary ==0.7.4.0, blaze-builder ==0.4.0.1, byteable ==0.1.1, bytestring ==0.10.6.0,@@ -24,12 +24,12 @@ cipher-aes ==0.2.10, cipher-des ==0.0.6, cipher-rc4 ==0.1.4,- clock ==0.4.1.3,+ clock ==0.4.5.0, comonad ==4.2.5, conduit ==1.2.4, configuration-tools ==0.2.12, connection ==0.2.4,- containers ==0.5.6.2,+ containers ==0.5.6.3, contravariant ==1.3.1, cookie ==0.4.1.4, crypto-cipher-types ==0.0.9,@@ -57,12 +57,12 @@ ghc-prim ==0.4.0.0, hashable ==1.2.3.2, hourglass ==0.2.8,- http-client ==0.4.9,+ http-client ==0.4.11.1, http-client-tls ==0.2.2, http-types ==0.8.6, integer-gmp ==1.0.0.0, kan-extensions ==4.2.1,- lens ==4.8,+ lens ==4.9.1, lifted-base ==0.2.3.6, mime-types ==0.1.0.6, mmorph ==1.0.4,@@ -77,7 +77,7 @@ parsec ==3.1.9, pem ==0.2.2, prelude-extras ==0.4,- pretty ==1.1.2.0,+ pretty ==1.1.3.2, primitive ==0.5.4.0, process ==1.2.3.0, profunctors ==4.4.1,@@ -94,13 +94,13 @@ socks ==0.5.4, stm ==2.4.4, stm-chans ==3.0.0.3,- streaming-commons ==0.1.10.0,+ streaming-commons ==0.1.12, syb ==0.4.4,- tagged ==0.7.3,+ tagged ==0.8.0.1, template-haskell ==2.10.0.0, text ==1.2.0.4, time ==1.5.0.1,- tls ==1.2.16,+ tls ==1.2.17, trace ==0.2.0.0, transformers ==0.4.2.0, transformers-base ==0.4.4,@@ -114,5 +114,5 @@ x509-store ==1.5.0, x509-system ==1.5.0, x509-validation ==1.5.1,- yaml ==0.8.10.1,- zlib ==0.5.4.2+ yaml ==0.8.11,+ zlib ==0.6.1.0
src/System/Logger.hs view
@@ -162,6 +162,11 @@ pLogConfig ∷ MParser LogConfig pLogConfig = pLogConfig_ "" +-- | A version of 'pLogConfig' that takes a prefix for the command+-- line option.+--+-- @since 0.2+-- pLogConfig_ ∷ T.Text -- ^ prefix for this and all subordinate command line options.
src/System/Logger/Backend/ColorOption.hs view
@@ -116,6 +116,11 @@ pColorOption ∷ O.Parser ColorOption pColorOption = pColorOption_ "" +-- | A version of 'pColorOption' that takes a prefix for the+-- command line option.+--+-- @since 0.2+-- pColorOption_ ∷ T.Text -- ^ prefix for the command line options.
src/System/Logger/Backend/Handle.hs view
@@ -56,7 +56,9 @@ -- * Backend Implementation , withHandleBackend+, withHandleBackend_ , handleBackend+, handleBackend_ ) where import Configuration.Utils hiding (Lens', Error)@@ -138,6 +140,11 @@ pLoggerHandleConfig ∷ O.Parser LoggerHandleConfig pLoggerHandleConfig = pLoggerHandleConfig_ "" +-- | A version of 'pLoggerHandleConfig' that takes a prefix for the+-- command line option.+--+-- @since 0.2+-- pLoggerHandleConfig_ ∷ T.Text -- ^ prefix for the command line options.@@ -194,6 +201,11 @@ pHandleBackendConfig ∷ MParser HandleBackendConfig pHandleBackendConfig = pHandleBackendConfig_ "" +-- | A version of 'pLoggerHandleBackendConfig' that takes a prefix for the+-- command line option.+--+-- @since 0.2+-- pHandleBackendConfig_ ∷ T.Text -- ^ prefix for this and all subordinate command line options.@@ -210,7 +222,22 @@ ⇒ HandleBackendConfig → (LoggerBackend T.Text → m α) → m α-withHandleBackend conf inner =+withHandleBackend = withHandleBackend_ id+{-# INLINE withHandleBackend #-}++-- | A version of 'withHandleBackend' that is generic in the type+-- of the log message.+--+-- @since 0.2.2+--+withHandleBackend_+ ∷ (MonadIO m, MonadBaseControl IO m)+ ⇒ (msg → T.Text)+ -- ^ formatting function for the log message+ → HandleBackendConfig+ → (LoggerBackend msg → m α)+ → m α+withHandleBackend_ format conf inner = case conf ^. handleBackendConfigHandle of StdErr → run stderr StdOut → run stdout@@ -218,21 +245,36 @@ where run h = do colored ← liftIO $ useColor (conf ^. handleBackendConfigColor) h- inner $ handleBackend h colored+ inner $ handleBackend_ format h colored handleBackend ∷ Handle → Bool -- ^ whether to use ANSI color escape codes → LoggerBackend T.Text-handleBackend h colored eitherMsg = do+handleBackend = handleBackend_ id+{-# INLINE handleBackend #-}++-- | A version of 'handleBackend' that is generic in the type of+-- the log message.+--+-- @since 0.2.2+--+handleBackend_+ ∷ (msg → T.Text)+ -- ^ formatting function for the log message+ → Handle+ → Bool+ -- ^ whether to use ANSI color escape codes+ → LoggerBackend msg+handleBackend_ format h colored eitherMsg = do T.hPutStrLn h $ formatIso8601Milli (msg ^. logMsgTime) ⊕ " " ⊕ inLevelColor colored ("[" ⊕ sshow level ⊕ "] ") ⊕ inScopeColor colored ("[" ⊕ formatedScope ⊕ "] ") ⊕ (msg ^. logMsg) where- msg = either id id eitherMsg+ msg = either id (logMsg %~ format) eitherMsg level = msg ^. logMsgLevel formatedScope = T.intercalate "|" ∘ L.map formatLabel ∘ reverse $ msg ^. logMsgScope@@ -262,5 +304,5 @@ inBlue ∷ T.Text → T.Text inBlue = inColor A.Dull A.Blue-{-# INLINEABLE handleBackend #-}+{-# INLINEABLE handleBackend_ #-}
src/System/Logger/Internal.hs view
@@ -56,6 +56,8 @@ -- | Format 'TimeSpec' as ISO8601 date-time string with -- microseconds precision. --+-- @since 0.2+-- formatIso8601Micro ∷ IsString a ⇒ TimeSpec@@ -65,6 +67,8 @@ -- | Format 'TimeSpec' as ISO8601 date-time string with -- milliseconds precision. --+-- @since 0.2+-- formatIso8601Milli ∷ IsString a ⇒ TimeSpec@@ -74,6 +78,8 @@ -- | Format 'TimeSpec' as ISO8601 date-time string with -- the given sub-second precision. --+-- @since 0.2+-- formatIso8601 ∷ IsString a ⇒ Natural@@ -83,12 +89,14 @@ formatIso8601 precision = fromString ∘ (⊕ "Z")- ∘ take (fromIntegral $ 21 + precision)+ ∘ take (fromIntegral $ 20 + precision) ∘ (⊕ replicate (fromIntegral precision) '0') ∘ formatTime defaultTimeLocale ("%Y-%m-%dT%H:%M:%S%Q") ∘ timeSpecToUtc -- | Convert a 'TimeSpec' value into 'UTCTime'+--+-- @since 0.2 -- timeSpecToUtc ∷ TimeSpec
src/System/Logger/Logger/Internal.hs view
@@ -150,13 +150,21 @@ -- the logger will discard all exceptions. For instance a value of @1@ -- means that an exception is raised when the second exception occurs. -- A value of @0@ means that an exception is raised for each exception.+ --+ -- @since 0.2+ , _loggerConfigExceptionWait ∷ !(Maybe Natural) -- ^ number of microseconds to wait after an exception from the backend. -- If this is 'Nothing' the logger won't wait at all after an exception.+ --+ -- @since 0.2+ , _loggerConfigExitTimeout ∷ !(Maybe Natural) -- ^ timeout in microseconds for the logger to flush the queue and -- deliver all remaining log messages on termination. If this is 'Nothing' -- termination of the logger blogs until all mesages are delivered.+ --+ -- @since 0.2 } deriving (Show, Read, Eq, Ord, Typeable, Generic) @@ -229,6 +237,11 @@ pLoggerConfig ∷ MParser LoggerConfig pLoggerConfig = pLoggerConfig_ "" +-- | A version of 'pLoggerConfig' that takes a prefix for the+-- command line option.+--+-- @since 0.2+-- pLoggerConfig_ ∷ T.Text -- ^ prefix for this and all subordinate command line options.@@ -370,6 +383,8 @@ -- | A version of 'createLogger' that takes as an extra argument -- a function for logging errors in the logging system. --+-- @since 0.2+-- createLogger_ ∷ MonadIO μ ⇒ (T.Text → IO ())@@ -555,6 +570,8 @@ -- | A version of 'withLogger' that takes as an extra argument -- a function for logging errors in the logging system. --+-- @since 0.2+-- withLogger_ ∷ (MonadIO μ, MonadBaseControl IO μ) ⇒ (T.Text → IO ())@@ -579,6 +596,8 @@ -- | For simple cases, when the logger threshold and the logger scope is -- constant this function can be used to directly initialize a log function.+--+-- @since 0.2 -- withLogFunction_ ∷ (Show a, Typeable a, NFData a, MonadIO μ, MonadBaseControl IO μ)
src/System/Logger/Types.hs view
@@ -89,7 +89,7 @@ ) where -import Configuration.Utils hiding (Lens', Error)+import Configuration.Utils hiding (Lens, Lens', Error) import Control.DeepSeq import Control.Exception@@ -167,6 +167,11 @@ pLogLevel ∷ O.Parser LogLevel pLogLevel = pLogLevel_ "" +-- | A version of 'pLogLevel' that takes a prefix for the command line+-- option.+--+-- @since 0.2+-- pLogLevel_ ∷ T.Text -- ^ prefix for the command line options.@@ -218,6 +223,11 @@ pLogPolicy ∷ O.Parser LogPolicy pLogPolicy = pLogPolicy_ "" +-- | A version of 'pLogPolicy' that takes a prefix for the+-- command line option.+--+-- @since 0.2+-- pLogPolicy_ ∷ T.Text -- ^ prefix for the command line options.@@ -236,6 +246,19 @@ -- -------------------------------------------------------------------------- -- -- Logger Exception +-- | Exceptions that are thrown by the logger+--+-- ['QueueFullException'] thrown when the queue is full and the logger policy+-- is set to throw exceptions on a full queue+--+-- ['BackendTerminatedException'] a backend can throw this exception to force+-- the logger immediately+--+-- ['BackendTooManyExceptions'] thrown when the backend has thrown unexpected+-- exceptions more than 'loggerConfigExceptionLimit' times+--+-- @since 0.2+-- data LoggerException a where QueueFullException ∷ LogMessage a → LoggerException a BackendTerminatedException ∷ SomeException → LoggerException Void@@ -270,10 +293,12 @@ -- on the respective system. NOTE that POSIX is ambigious with regard -- to treatment of leap seconds, and some implementations may actually -- return TAI.+ --+ -- @since 0.2 } deriving (Show, Read, Eq, Ord, Typeable, Generic) -logMsg ∷ Lens' (LogMessage a) a+logMsg ∷ Lens (LogMessage a) (LogMessage b) a b logMsg = lens _logMsg $ \a b → a { _logMsg = b } logMsgLevel ∷ Lens' (LogMessage a) LogLevel@@ -282,6 +307,8 @@ logMsgScope ∷ Lens' (LogMessage a) LogScope logMsgScope = lens _logMsgScope $ \a b → a { _logMsgScope = b } +-- | @since 0.2+-- logMsgTime ∷ Lens' (LogMessage a) TimeSpec logMsgTime = lens _logMsgTime $ \a b → a { _logMsgTime = b } @@ -328,17 +355,45 @@ -- MonadLog class Monad m ⇒ MonadLog a m | m → a where++ -- | Log a message.+ -- logg ∷ LogFunction a m++ -- | Run the inner computation with the given 'LogLevel' withLevel ∷ LogLevel → m α → m α++ -- | Run the inner computation with the given 'LogPolicy'. withPolicy ∷ LogPolicy → m α → m α++ -- | Run the inner computation with a modified 'LogScope'.+ --+ -- @since 0.1+ -- localScope ∷ (LogScope → LogScope) → m α → m α +-- | Append a 'LogLabel' to the current 'LogScope' when executing the+-- inner computation. The 'LogScope' of the outer computation is unchanged.+--+-- @since 0.1+-- withLabel ∷ MonadLog a m ⇒ LogLabel → m α → m α withLabel = localScope ∘ (:) +-- | Remove the last 'LogLabel' from the current 'LogScope' when+-- executing the inner computation. The 'LogScope' of the outer+-- computation is unchanged.+--+-- @since 0.1+-- popLabel ∷ MonadLog a m ⇒ m α → m α popLabel = localScope $ \case { [] → []; (_:t) → t } +-- | Executing the inner computation with an empty 'LogScope'. The+-- 'LogScope' of the outer computation is unchanged.+--+-- @since 0.1+-- clearScope ∷ MonadLog a m ⇒ m α → m α clearScope = localScope $ const []
test/TastyTools.hs view
@@ -14,6 +14,7 @@ -- Stability: experimental -- +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE RankNTypes #-}@@ -31,9 +32,15 @@ , testCaseSteps ) where +#ifndef MIN_VERSION_base+#define MIN_VESION_base(x,y,z) 1+#endif+ import Configuration.Utils (boolReader) +#if ! MIN_VERSION_base(4,8,0) import Control.Applicative+#endif import Control.Exception (try) import Control.Monad import Control.Monad.IO.Class@@ -67,7 +74,7 @@ -- | Function to report progress -- type ProgressFunction- = MonadIO m+ = ∀ m . MonadIO m ⇒ Float -- ^ progress measure → T.Text@@ -121,7 +128,7 @@ -- | Function to report progress -- type StepFunction- = MonadIO m+ = ∀ m . MonadIO m ⇒ T.Text -- ^ progress message → m ()
yet-another-logger.cabal view
@@ -1,5 +1,5 @@ Name: yet-another-logger-Version: 0.2.1+Version: 0.2.2 Synopsis: Yet Another Logger Description: A logging framework written with flexibility and performance@@ -73,7 +73,7 @@ type: git location: https://github.com/alephcloud/hs-yet-another-logger branch: master- tag: 0.2.1+ tag: 0.2.2 Library default-language: Haskell2010