packages feed

yet-another-logger 0.3.1 → 0.4.0

raw patch · 12 files changed

+118/−146 lines, 12 filesdep +microlensdep −case-insensitivedep −lensnew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: microlens

Dependencies removed: case-insensitive, lens

API changes (from Hackage documentation)

- System.Logger.Logger.Internal: instance GHC.Exception.Exception System.Logger.Logger.Internal.LoggerKilled
- System.Logger.Types: instance (Data.Typeable.Internal.Typeable a, GHC.Show.Show a) => GHC.Exception.Exception (System.Logger.Types.LoggerException a)
+ System.Logger.Logger.Internal: instance GHC.Exception.Type.Exception System.Logger.Logger.Internal.LoggerKilled
+ System.Logger.Types: instance (Data.Typeable.Internal.Typeable a, GHC.Show.Show a) => GHC.Exception.Type.Exception (System.Logger.Types.LoggerException a)
- System.Logger.Backend.ColorOption: readColorOption :: (Monad m, Eq a, Show a, FoldCase a, IsString a, IsString e, Monoid e, MonadError e m) => a -> m ColorOption
+ System.Logger.Backend.ColorOption: readColorOption :: (Monad m, IsString e, Monoid e, MonadError e m) => Text -> m ColorOption
- System.Logger.Backend.Handle: readLoggerHandleConfig :: (MonadError e m, Eq a, Show a, FoldCase a, IsText a, IsString e, Monoid e) => a -> m LoggerHandleConfig
+ System.Logger.Backend.Handle: readLoggerHandleConfig :: (MonadError e m, IsString e, Monoid e) => Text -> m LoggerHandleConfig
- System.Logger.Logger: LoggerConfig :: !Natural -> !LogLevel -> !LogScope -> !LogPolicy -> !(Maybe Natural) -> !(Maybe Natural) -> !(Maybe Natural) -> LoggerConfig
+ System.Logger.Logger: LoggerConfig :: !Natural -> !LogLevel -> !LogScope -> !LogPolicy -> !Maybe Natural -> !Maybe Natural -> !Maybe Natural -> LoggerConfig
- System.Logger.Logger: [_loggerConfigExceptionLimit] :: LoggerConfig -> !(Maybe Natural)
+ System.Logger.Logger: [_loggerConfigExceptionLimit] :: LoggerConfig -> !Maybe Natural
- System.Logger.Logger: [_loggerConfigExceptionWait] :: LoggerConfig -> !(Maybe Natural)
+ System.Logger.Logger: [_loggerConfigExceptionWait] :: LoggerConfig -> !Maybe Natural
- System.Logger.Logger: [_loggerConfigExitTimeout] :: LoggerConfig -> !(Maybe Natural)
+ System.Logger.Logger: [_loggerConfigExitTimeout] :: LoggerConfig -> !Maybe Natural
- System.Logger.Logger.Internal: LoggerConfig :: !Natural -> !LogLevel -> !LogScope -> !LogPolicy -> !(Maybe Natural) -> !(Maybe Natural) -> !(Maybe Natural) -> LoggerConfig
+ System.Logger.Logger.Internal: LoggerConfig :: !Natural -> !LogLevel -> !LogScope -> !LogPolicy -> !Maybe Natural -> !Maybe Natural -> !Maybe Natural -> LoggerConfig
- System.Logger.Logger.Internal: [_loggerConfigExceptionLimit] :: LoggerConfig -> !(Maybe Natural)
+ System.Logger.Logger.Internal: [_loggerConfigExceptionLimit] :: LoggerConfig -> !Maybe Natural
- System.Logger.Logger.Internal: [_loggerConfigExceptionWait] :: LoggerConfig -> !(Maybe Natural)
+ System.Logger.Logger.Internal: [_loggerConfigExceptionWait] :: LoggerConfig -> !Maybe Natural
- System.Logger.Logger.Internal: [_loggerConfigExitTimeout] :: LoggerConfig -> !(Maybe Natural)
+ System.Logger.Logger.Internal: [_loggerConfigExitTimeout] :: LoggerConfig -> !Maybe Natural
- System.Logger.Types: readLogLevel :: (MonadError e m, Eq a, Show a, FoldCase a, IsString a, IsString e, Monoid e) => a -> m LogLevel
+ System.Logger.Types: readLogLevel :: (MonadError e m, IsString e, Monoid e) => Text -> m LogLevel
- System.Logger.Types: readLogPolicy :: (MonadError e m, Eq a, Show a, FoldCase a, IsText a, IsString e, Monoid e) => a -> m LogPolicy
+ System.Logger.Types: readLogPolicy :: (MonadError e m, IsString e, Monoid e) => Text -> m LogPolicy
- System.Logger.Types: setLoggerLevel :: LoggerCtx ctx msg => Setter' ctx LogLevel
+ System.Logger.Types: setLoggerLevel :: LoggerCtx ctx msg => Lens' ctx LogLevel
- System.Logger.Types: setLoggerPolicy :: LoggerCtx ctx msg => Setter' ctx LogPolicy
+ System.Logger.Types: setLoggerPolicy :: LoggerCtx ctx msg => Lens' ctx LogPolicy
- System.Logger.Types: setLoggerScope :: LoggerCtx ctx msg => Setter' ctx LogScope
+ System.Logger.Types: setLoggerScope :: LoggerCtx ctx msg => Lens' ctx LogScope

Files

CHANGELOG.md view
@@ -1,6 +1,21 @@-0.3.1-=====+# yet-another-logger +## 0.4.0 (2020-04-07)++#### Changed++- `microlens` is now used in place of `lens`.+- The three lensy functions of the `LoggerCtx` class which were previously+  `Setter'` are now `Lens'`.+- The following functions are now less polymorphic, requiring a strict `Text`+  instead of anything that had a `IsText` instance:+  - `readColorOption`+  - `readLoggerHandleConfig`+  - `readLogLevel`+  - `readLogPolicy`++## 0.3.1+ *   Add support for tasty-hunit >= 0.10.  *   Raise lower bounds on some dependencies:@@ -13,8 +28,7 @@  *   Drop support for GHC < 7.10. -0.3.0-=====+## 0.3.0  *   Remove `EitherT` instance. It's recommended to use `ExceptT` instead. @@ -28,20 +42,17 @@  *   Support for Cabal-1.18 and time >= 1.4 && < 1.5. -0.2.3.1-=======+## 0.2.3.1  *   Add missing NFData instance for `Natural` when build with     deepseq>=1.4 and base<4.8. -0.2.3-=====+## 0.2.3  *   Fix semantically invalid default NFData instance when build with     deepseq <1.4. -0.2.2-=====+## 0.2.2  *   [Issue #28] Generalized type of lens `logMsg` to support changing     the message type.@@ -52,13 +63,11 @@     in the log message type and accept a formatting function for     formatting the log message as text. -0.2.1-=====+## 0.2.1  *   Support for trace-0.2. -0.2-===+## 0.2  *   Removed `MonadLogIO`; `MonadBaseControl` should be used instead. @@ -113,14 +122,12 @@ *   Issue #6: use `TBMChan` as internal queue implementation until a new version of     stm is released with a [fix for `TQueue`](https://ghc.haskell.org/trac/ghc/ticket/9539). -0.1.1-=====+## 0.1.1  *   Added `MonadLogIO` for loggers that allow to extract a log     function of type `LogFunctionIO`. -0.1-===+## 0.1  *   Added `localScope` function to `MonadLog` and and implemented `withLabel`     based on it.@@ -132,8 +139,6 @@  *   Lift `MonadTrace` instances into `LoggerCtxT`. -0.0.1-=====+## 0.0.1  First public release-
README.md view
@@ -1,4 +1,4 @@-[![Build Status](https://travis-ci.org/alephcloud/hs-yet-another-logger.svg)](https://travis-ci.org/alephcloud/hs-yet-another-logger)+![](https://github.com/alephcloud/hs-yet-another-logger/workflows/Tests/badge.svg)  A logging framework written with flexibility and performance in mind. @@ -103,4 +103,3 @@ modular design, which decouples generation and serialization of log messages, allows one to accommodate these different scenarios by just using different back-ends, possibly parameterized by the formatting function.-
src/System/Logger.hs view
@@ -29,13 +29,13 @@ -- "System.Logger.Backend.Handle". -- -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UnicodeSyntax #-} @@ -64,7 +64,6 @@  import Configuration.Utils hiding (Lens') -import Control.Lens hiding ((.=)) import Control.Monad.IO.Class import Control.Monad.Trans.Control @@ -73,6 +72,8 @@  import GHC.Generics +import Lens.Micro+ import Prelude.Unicode  import System.Logger.Backend.ColorOption@@ -156,8 +157,8 @@  instance FromJSON (LogConfig → LogConfig) where     parseJSON = withObject "LogConfig" $ \o → id-        <$< logConfigLogger %.: "logger" × o-        <*< logConfigBackend %.: "backend" × o+        <$< logConfigLogger %.: "logger" % o+        <*< logConfigBackend %.: "backend" % o  pLogConfig ∷ MParser LogConfig pLogConfig = pLogConfig_ ""
src/System/Logger/Backend/ColorOption.hs view
@@ -1,4 +1,4 @@--- Copyright (c) 2016-2018 Lars Kuhtz <lakuhtz@gmail.com>+-- Copyright (c) 2016-2020 Lars Kuhtz <lakuhtz@gmail.com> -- Copyright (c) 2014-2015 PivotCloud, Inc. -- -- System.Logger.Backend.ColorOption@@ -20,7 +20,7 @@ -- | -- Module: System.Logger.Backend.ColorOption -- Copyright:---     Copyright (c) 2016-2018 Lars Kuhtz <lakuhtz@gmail.com>+--     Copyright (c) 2016-2020 Lars Kuhtz <lakuhtz@gmail.com> --     Copyright (c) 2014-2015 PivotCloud, Inc. -- License: Apache License, Version 2.0 -- Maintainer: Lars Kuhtz <lakuhtz@gmail.com>@@ -51,7 +51,6 @@ import Control.DeepSeq import Control.Monad.Except -import qualified Data.CaseInsensitive as CI import Data.Monoid.Unicode import Data.String import qualified Data.Text as T@@ -80,10 +79,10 @@ instance NFData ColorOption  readColorOption-    ∷ (Monad m, Eq a, Show a, CI.FoldCase a, IsString a, IsString e, Monoid e, MonadError e m)-    ⇒ a+    ∷ (Monad m, IsString e, Monoid e, MonadError e m)+    ⇒ T.Text     → m ColorOption-readColorOption x = case CI.mk x of+readColorOption x = case T.toLower x of     "auto" → return ColorAuto     "false" → return ColorFalse     "true" → return ColorTrue@@ -120,8 +119,8 @@     ∷ T.Text         -- ^ prefix for the command line options.     → O.Parser ColorOption-pColorOption_ prefix = option (eitherReader readColorOption)-   × long (T.unpack prefix ⊕ "color")+pColorOption_ prefix = option (eitherReader (readColorOption . T.pack))+   % long (T.unpack prefix ⊕ "color")    ⊕ short 'c'    ⊕ help "whether to use ANSI terminal colors in the output" @@ -132,4 +131,3 @@ useColor ColorFalse _ = return False useColor ColorTrue _ = return True useColor ColorAuto handle = A.hSupportsANSI handle-
src/System/Logger/Backend/Handle.hs view
@@ -1,4 +1,4 @@--- Copyright (c) 2016-2018 Lars Kuhtz <lakuhtz@gmail.com>+-- Copyright (c) 2016-2020 Lars Kuhtz <lakuhtz@gmail.com> -- Copyright (c) 2014-2015 PivotCloud, Inc. -- -- System.Logger.Backend.Handle@@ -21,7 +21,7 @@ -- Module: System.Logger.Backend.Handle -- Description: Handle Backend for Yet Another Logger -- Copyright:---     Copyright (c) 2016-2018 Lars Kuhtz <lakuhtz@gmail.com>+--     Copyright (c) 2016-2020 Lars Kuhtz <lakuhtz@gmail.com> --     Copyright (c) 2014-2015 PivotCloud, Inc. -- License: Apache License, Version 2.0 -- Maintainer: Lars Kuhtz <lakuhtz@gmail.com>@@ -29,12 +29,12 @@ --  {-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UnicodeSyntax #-} @@ -64,26 +64,25 @@ , handleBackend_ ) where -import Configuration.Utils hiding (Lens', Error)+import Configuration.Utils hiding (Error, Lens') import Configuration.Utils.Validation  import Control.DeepSeq-import Control.Lens hiding ((.=)) import Control.Monad.Except import Control.Monad.Trans.Control import Control.Monad.Writer -import qualified Data.CaseInsensitive as CI import qualified Data.List as L import Data.Monoid.Unicode import Data.String import qualified Data.Text as T-import Data.Text.Lens import qualified Data.Text.IO as T import Data.Typeable  import GHC.Generics +import Lens.Micro+ import qualified Options.Applicative as O  import Prelude.Unicode@@ -109,18 +108,16 @@ instance NFData LoggerHandleConfig  readLoggerHandleConfig-    ∷ (MonadError e m, Eq a, Show a, CI.FoldCase a, IsText a, IsString e, Monoid e)-    ⇒ a+    ∷ (MonadError e m, IsString e, Monoid e)+    ⇒ T.Text     → m LoggerHandleConfig-readLoggerHandleConfig x = case CI.mk tx of+readLoggerHandleConfig x = case T.toLower x of     "stdout" → return StdOut     "stderr" → return StdErr-    _ | CI.mk (L.take 5 tx) ≡ "file:" → return $ FileHandle (L.drop 5 tx)+    tx | T.take 5 tx ≡ "file:" → return . FileHandle . T.unpack $ T.drop 5 tx     e → throwError $ "unexpected logger handle value: "         ⊕ fromString (show e)         ⊕ ", expected \"stdout\", \"stderr\", or \"file:<FILENAME>\""-  where-    tx = packed # x  loggerHandleConfigText     ∷ (IsString a, Monoid a)@@ -152,8 +149,8 @@     ∷ T.Text         -- ^ prefix for the command line options.     → O.Parser LoggerHandleConfig-pLoggerHandleConfig_ prefix = option (eitherReader readLoggerHandleConfig)-    × long (T.unpack prefix ⊕ "logger-backend-handle")+pLoggerHandleConfig_ prefix = option (eitherReader (readLoggerHandleConfig . T.pack))+    % long (T.unpack prefix ⊕ "logger-backend-handle")     ⊕ metavar "stdout|stderr|file:<FILENAME>"     ⊕ help "handle where the logs are written" @@ -198,8 +195,8 @@  instance FromJSON (HandleBackendConfig → HandleBackendConfig) where     parseJSON = withObject "HandleBackendConfig" $ \o → id-        <$< handleBackendConfigColor ..: "color" × o-        <*< handleBackendConfigHandle ..: "handle" × o+        <$< handleBackendConfigColor ..: "color" % o+        <*< handleBackendConfigHandle ..: "handle" % o  pHandleBackendConfig ∷ MParser HandleBackendConfig pHandleBackendConfig = pHandleBackendConfig_ ""@@ -308,4 +305,3 @@     inBlue ∷ T.Text → T.Text     inBlue = inColor A.Dull A.Blue {-# INLINEABLE handleBackend_ #-}-
src/System/Logger/Internal.hs view
@@ -1,7 +1,7 @@ -- | -- Module: System.Logger.Internal -- Copyright:---     Copyright (c) 2016-2018 Lars Kuhtz <lakuhtz@gmail.com>+--     Copyright (c) 2016-2020 Lars Kuhtz <lakuhtz@gmail.com> --     Copyright (c) 2014-2015 PivotCloud, Inc. -- License: Apache License, Version 2.0 -- Maintainer: Lars Kuhtz <lakuhtz@gmail.com>@@ -20,10 +20,10 @@ ) where  import Data.Monoid.Unicode+import Data.String import Data.Time.Clock import Data.Time.Clock.POSIX import Data.Time.Format-import Data.String  import Numeric.Natural @@ -88,4 +88,3 @@     → UTCTime timeSpecToUtc (TimeSpec s ns) =     posixSecondsToUTCTime (realToFrac s + realToFrac ns * 1e-9)-
src/System/Logger/Internal/Queue.hs view
@@ -1,4 +1,4 @@--- Copyright (c) 2016-2018 Lars Kuhtz <lakuhtz@gmail.com>+-- Copyright (c) 2016-2020 Lars Kuhtz <lakuhtz@gmail.com> -- Copyright (c) 2014-2015 PivotCloud, Inc. -- -- System.Logger@@ -21,7 +21,7 @@ -- Module: System.Logger.Internal.Queue -- Description: Queues for Usage with Yet Another Logger -- Copyright:---     Copyright © 2016-2018 Lars Kuhtz <lakuhtz@gmail.com>+--     Copyright © 2016-2020 Lars Kuhtz <lakuhtz@gmail.com> --     Copyright © 2015 PivotCloud, Inc. -- License: Apache-2.0 -- Maintainer: Lars Kuhtz <lakuhtz@gmail.com>@@ -31,9 +31,9 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UnicodeSyntax #-} @@ -138,4 +138,3 @@     tryWriteQueue FairTBMQueue{..} a = do         withMVar fairTBMQueueLock $ \_ → do             tryWriteQueue fairTBMQueueQueue a-
src/System/Logger/Logger/Internal.hs view
@@ -1,4 +1,4 @@--- Copyright (c) 2016-2018 Lars Kuhtz <lakuhtz@gmail.com>+-- Copyright (c) 2016-2020 Lars Kuhtz <lakuhtz@gmail.com> -- Copyright (c) 2014-2015 PivotCloud, Inc. -- -- System.Logger.Logger.Internal@@ -21,7 +21,7 @@ -- Module: System.Logger.Logger.Internal -- Description: Yet Another Logger Implementation -- Copyright:---     Copyright (c) 2016-2018 Lars Kuhtz <lakuhtz@gmail.com>+--     Copyright (c) 2016-2020 Lars Kuhtz <lakuhtz@gmail.com> --     Copyright (c) 2014-2015 PivotCloud, Inc. -- License: Apache License, Version 2.0 -- Maintainer: Lars Kuhtz <lakuhtz@gmail.com>@@ -35,11 +35,11 @@ --  {-# LANGUAGE CPP #-}-{-# LANGUAGE GADTs #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-}@@ -82,29 +82,30 @@ , runLogT ) where -import Configuration.Utils hiding (Lens', Error)+import Configuration.Utils hiding (Error, Lens')  import Control.Concurrent (threadDelay) import Control.Concurrent.Async -- FIXME: use a better data structure with non-amortized complexity bounds-import Control.Monad.STM import Control.Concurrent.STM.TVar import Control.DeepSeq-import Control.Exception.Lifted import Control.Exception.Enclosed-import Control.Lens hiding ((.=))+import Control.Exception.Lifted import Control.Monad.Except+import Control.Monad.STM import Control.Monad.Trans.Control import Control.Monad.Unicode  import Data.Monoid.Unicode import qualified Data.Text as T-import Data.Typeable import qualified Data.Text.IO as T (hPutStrLn)+import Data.Typeable import Data.Void  import GHC.Generics +import Lens.Micro+ import Numeric.Natural  import Prelude.Unicode@@ -214,13 +215,13 @@  instance FromJSON (LoggerConfig → LoggerConfig) where     parseJSON = withObject "LoggerConfig" $ \o → id-        <$< loggerConfigQueueSize ..: "queue_size" × o-        <*< loggerConfigThreshold ..: "log_level" × o-        <*< loggerConfigScope ..: "scope" × o-        <*< loggerConfigPolicy ..: "policy" × o-        <*< loggerConfigExceptionLimit ..: "exception_limit" × o-        <*< loggerConfigExceptionWait ..: "exception_wait" × o-        <*< loggerConfigExitTimeout ..: "exit_timeout" × o+        <$< loggerConfigQueueSize ..: "queue_size" % o+        <*< loggerConfigThreshold ..: "log_level" % o+        <*< loggerConfigScope ..: "scope" % o+        <*< loggerConfigPolicy ..: "policy" % o+        <*< loggerConfigExceptionLimit ..: "exception_limit" % o+        <*< loggerConfigExceptionWait ..: "exception_wait" % o+        <*< loggerConfigExitTimeout ..: "exit_timeout" % o  pLoggerConfig ∷ MParser LoggerConfig pLoggerConfig = pLoggerConfig_ ""@@ -236,21 +237,21 @@     → MParser LoggerConfig pLoggerConfig_ prefix = id     <$< loggerConfigQueueSize .:: option auto-        × long (T.unpack prefix ⊕ "queue-size")+        % long (T.unpack prefix ⊕ "queue-size")         ⊕ metavar "INT"         ⊕ help "size of the internal logger queue"     <*< loggerConfigThreshold .:: pLogLevel_ prefix     <*< loggerConfigPolicy .:: pLogPolicy_ prefix-    <*< loggerConfigExceptionLimit .:: fmap Just × option auto-        × long (T.unpack prefix ⊕ "exception-limit")+    <*< loggerConfigExceptionLimit .:: fmap Just % option auto+        % long (T.unpack prefix ⊕ "exception-limit")         ⊕ metavar "INT"         ⊕ help "maximal number of backend failures before and exception is raised"-    <*< loggerConfigExceptionWait .:: fmap Just × option auto-        × long (T.unpack prefix ⊕ "exception-wait")+    <*< loggerConfigExceptionWait .:: fmap Just % option auto+        % long (T.unpack prefix ⊕ "exception-wait")         ⊕ metavar "INT"         ⊕ help "time to wait after an backend failure occured"-    <*< loggerConfigExitTimeout .:: fmap Just × option auto-        × long (T.unpack prefix ⊕ "exit-timeout")+    <*< loggerConfigExitTimeout .:: fmap Just % option auto+        % long (T.unpack prefix ⊕ "exit-timeout")         ⊕ metavar "INT"         ⊕ help "timeout for flushing the log message queue on exit" @@ -286,14 +287,6 @@     }     deriving (Typeable, Generic) -loggerQueue ∷ Lens' (Logger a) (LoggerQueue a)-loggerQueue = lens _loggerQueue $ \a b → a { _loggerQueue = b }-{-# INLINE loggerQueue #-}--loggerWorker ∷ Lens' (Logger a) (Async ())-loggerWorker = lens _loggerWorker $ \a b → a { _loggerWorker = b }-{-# INLINE loggerWorker #-}- loggerThreshold ∷ Lens' (Logger a) LogLevel loggerThreshold = lens _loggerThreshold $ \a b → a { _loggerThreshold = b } {-# INLINE loggerThreshold #-}@@ -306,18 +299,6 @@ loggerPolicy = lens _loggerPolicy $ \a b → a { _loggerPolicy = b } {-# INLINE loggerPolicy #-} -loggerMissed ∷ Lens' (Logger a) (TVar Natural)-loggerMissed = lens _loggerMissed $ \a b → a { _loggerMissed = b }-{-# INLINE loggerMissed #-}--loggerExitTimeout ∷ Lens' (Logger a) (Maybe Natural)-loggerExitTimeout = lens _loggerExitTimeout $ \a b → a { _loggerExitTimeout = b }-{-# INLINE loggerExitTimeout #-}--loggerErrLogFunction ∷ Lens' (Logger a) (T.Text → IO ())-loggerErrLogFunction = lens _loggerErrLogFunction $ \a b → a { _loggerErrLogFunction = b }-{-# INLINE loggerErrLogFunction #-}- -- | Create a new logger. A logger created with this function must be released -- with a call to 'releaseLogger' and must not be used after it is released. --@@ -684,5 +665,3 @@     loggG level $ label ⊕ " failed: "  ⊕ T.intercalate " <|> " e     throwError [label ⊕ " failed"] -}--
src/System/Logger/Types.hs view
@@ -1,4 +1,4 @@--- Copyright (c) 2016-2018 Lars Kuhtz <lakuhtz@gmail.com>+-- Copyright (c) 2016-2020 Lars Kuhtz <lakuhtz@gmail.com> -- Copyright (c) 2014-2015 PivotCloud, Inc. -- -- System.Logger.Types@@ -21,7 +21,7 @@ -- Module: System.Logger.Types -- Description: Basic Types of Yet Another Logger -- Copyright:---     Copyright (c) 2016-2018 Lars Kuhtz <lakuhtz@gmail.com>+--     Copyright (c) 2016-2020 Lars Kuhtz <lakuhtz@gmail.com> --     Copyright (c) 2014-2015 PivotCloud, Inc. -- License: Apache License, Version 2.0 -- Maintainer: Lars Kuhtz <lakuhtz@gmail.com>@@ -44,6 +44,8 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UnicodeSyntax #-} +{-# OPTIONS_GHC -fno-warn-orphans #-}+ module System.Logger.Types ( -- * LogLevel@@ -96,7 +98,6 @@  import Control.DeepSeq import Control.Exception-import Control.Lens hiding ((.=)) import Control.Monad.Base import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask) import Control.Monad.Except@@ -106,16 +107,16 @@ import Control.Monad.Writer import Control.Monad.Unicode -import qualified Data.CaseInsensitive as CI import Data.Monoid.Unicode import Data.String import qualified Data.Text as T-import Data.Text.Lens import Data.Typeable import Data.Void  import GHC.Generics +import Lens.Micro+ import qualified Options.Applicative as O  import Prelude.Unicode@@ -136,10 +137,10 @@ instance NFData LogLevel  readLogLevel-    ∷ (MonadError e m, Eq a, Show a, CI.FoldCase a, IsString a, IsString e, Monoid e)-    ⇒ a+    ∷ (MonadError e m, IsString e, Monoid e)+    ⇒ T.Text     → m LogLevel-readLogLevel x = case CI.mk x of+readLogLevel x = case T.toLower x of     "quiet" → return Quiet     "error" → return Error     "warn" → return Warn@@ -177,8 +178,8 @@     ∷ T.Text         -- ^ prefix for the command line options.     → O.Parser LogLevel-pLogLevel_ prefix = option (eitherReader readLogLevel)-    × long (T.unpack prefix ⊕ "log-level")+pLogLevel_ prefix = option (eitherReader (readLogLevel . T.pack))+    % long (T.unpack prefix ⊕ "log-level")     ⊕ metavar "quiet|error|warn|info|debug"     ⊕ help "threshold for log messages" @@ -202,18 +203,16 @@ logPolicyText LogPolicyBlock = "block"  readLogPolicy-    ∷ (MonadError e m, Eq a, Show a, CI.FoldCase a, IsText a, IsString e, Monoid e)-    ⇒ a+    ∷ (MonadError e m, IsString e, Monoid e)+    ⇒ T.Text     → m LogPolicy-readLogPolicy x = case CI.mk tx of+readLogPolicy x = case T.toLower x of     "discard" → return LogPolicyDiscard     "raise" → return LogPolicyRaise     "block" → return LogPolicyBlock     e → throwError         $ "invalid log policy value " ⊕ fromString (show e) ⊕ ";"         ⊕ " the log policy value must be one of \"discard\", \"raise\", or \"block\""-  where-    tx = packed # x  instance ToJSON LogPolicy where     toJSON = toJSON ∘ (logPolicyText ∷ LogPolicy → T.Text)@@ -233,8 +232,8 @@     ∷ T.Text         -- ^ prefix for the command line options.     → O.Parser LogPolicy-pLogPolicy_ prefix = option (eitherReader readLogPolicy)-    × long (T.unpack prefix ⊕ "log-policy")+pLogPolicy_ prefix = option (eitherReader (readLogPolicy . T.pack))+    % long (T.unpack prefix ⊕ "log-policy")     ⊕ metavar "block|raise|discard"     ⊕ help "how to deal with a congested logging pipeline" @@ -497,9 +496,9 @@         ⇒ ctx         → LogFunctionIO msg -    setLoggerLevel ∷ Setter' ctx LogLevel-    setLoggerScope ∷ Setter' ctx LogScope-    setLoggerPolicy ∷ Setter' ctx LogPolicy+    setLoggerLevel ∷ Lens' ctx LogLevel+    setLoggerScope ∷ Lens' ctx LogScope+    setLoggerPolicy ∷ Lens' ctx LogPolicy      withLoggerLevel ∷ LogLevel → ctx → (ctx → α) → α     withLoggerLevel level ctx f = f $ ctx & setLoggerLevel .~ level@@ -547,4 +546,3 @@     {-# INLINE withLevel #-}     {-# INLINE withPolicy #-}     {-# INLINE localScope #-}-
test/NoBackend.hs view
@@ -14,10 +14,10 @@ -- Stability: experimental -- -{-# LANGUAGE GADTs #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-}@@ -35,7 +35,6 @@ import Control.Exception.Enclosed import Control.Monad import Control.Monad.Unicode-import Control.Lens  import Data.IORef import Data.Monoid.Unicode@@ -44,10 +43,12 @@ import Data.Typeable import Data.Void -import Numeric.Natural- import GHC.Generics +import Lens.Micro++import Numeric.Natural+ import Prelude.Unicode  import Test.Tasty@@ -330,4 +331,3 @@  sshow ∷ (Show a, IsString b) ⇒ a → b sshow = fromString ∘ show-
test/TastyTools.hs view
@@ -1,4 +1,4 @@--- Copyright (c) 2016-2018 Lars Kuhtz <lakuhtz@gmail.com>+-- Copyright (c) 2016-2020 Lars Kuhtz <lakuhtz@gmail.com> -- Copyright (c) 2013-2015 PivotCloud, Inc. All Rights Reserved. -- -- NOTICE: The dissemination, reproduction, or copying of this file and the@@ -10,7 +10,7 @@ -- | -- Module: TastyTools -- Copyright:---     Copyright (c) 2016-2018 Lars Kuhtz <lakuhtz@gmail.com>+--     Copyright (c) 2016-2020 Lars Kuhtz <lakuhtz@gmail.com> --     Copyright (c) 2013-2015 PivotCloud, Inc. All Rights Reserved. -- License: All Rights Reserved, see LICENSE file of the package -- Maintainer: Lars Kuhtz <lakuhtz@gmail>@@ -18,11 +18,11 @@ --  {-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UnicodeSyntax #-} @@ -140,4 +140,3 @@     → TestTree testCaseSteps testName inner = singleTest (T.unpack testName) $     TestCaseProgress $ \f → inner (f 0)-
yet-another-logger.cabal view
@@ -1,6 +1,6 @@-Cabal-version: 1.22+Cabal-version: 2.2 Name: yet-another-logger-Version: 0.3.1+Version: 0.4.0 Synopsis: Yet Another Logger Description:     A logging framework written with flexibility and performance@@ -54,7 +54,7 @@ Author: Lars Kuhtz <lakuhtz@gmail.com> Maintainer: Lars Kuhtz <lakuhtz@gmail.com> Copyright:-    Copyright (c) 2016-2018 Lars Kuhtz <lakuhtz@gmail.com>+    Copyright (c) 2016-2020 Lars Kuhtz <lakuhtz@gmail.com>     Copyright (c) 2014-2015 PivotCloud, Inc. Category: Logging, System Build-type: Simple@@ -95,14 +95,13 @@         base >= 4.8 && < 5.0,         base-unicode-symbols >= 0.2,         bytestring >= 0.10,-        case-insensitive >= 1.2,         clock >= 0.4,         configuration-tools >= 0.2.8,         deepseq >= 1.4,         enclosed-exceptions >= 1.0,         exceptions >= 0.8,-        lens >= 4.6,         lifted-base >= 0.2.3,+        microlens >= 0.4,         monad-control >= 1.0,         mtl >= 2.2,         optparse-applicative >= 0.11,@@ -132,8 +131,8 @@         base-unicode-symbols >= 0.2,         configuration-tools >= 0.2.12,         enclosed-exceptions >= 1.0,-        lens >= 4.7,         lifted-base >= 0.2,+        microlens >= 0.4,         tagged >= 0.7,         tasty >= 0.10,         tasty-hunit >= 0.9,