simple-logger 0.1.0 → 0.1.1

raw patch · 4 files changed

+49/−20 lines, 4 filesdep +monad-logger

Dependencies added: monad-logger

Files

package.yaml +2/−1
simple-logger.cabal +3/−2
src/Control/Logger/Simple.hs +42/−16
stack.yaml +2/−1

package.yaml view

@@ -1,5 +1,5 @@ name: simple-logger-version: 0.1.0+version: 0.1.1 synopsis: A very simple but efficient logging framework description: A very simple but efficient logging framework category: Logging@@ -15,6 +15,7 @@  dependencies:   - base >= 4.9 && < 5+  - monad-logger  library:   source-dirs: src

simple-logger.cabal view

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: b5edd8600dd9e617fd590c0555243903dbd58f9f67496b265b3947d5e0616faf+-- hash: ce87da47c5034f1b6490c7819839f05365997167fca44c7a7541a88fbdc6dde7  name:           simple-logger-version:        0.1.0+version:        0.1.1 synopsis:       A very simple but efficient logging framework description:    A very simple but efficient logging framework category:       Logging@@ -33,6 +33,7 @@   build-depends:       base >=4.9 && <5     , fast-logger+    , monad-logger     , mtl     , text   exposed-modules:

src/Control/Logger/Simple.hs view

@@ -8,6 +8,7 @@     , logFail     , pureTrace, pureDebug, pureInfo, pureNote, pureWarn, pureError     , showText, (<>)+    , monadLoggerAdapter, runSimpleLoggingT     ) where @@ -24,6 +25,7 @@ import qualified GHC.SrcLoc as GHC #endif import qualified GHC.Stack as GHC+import qualified Control.Monad.Logger as ML  data Loggers     = Loggers@@ -52,32 +54,32 @@  -- | Log with 'LogTrace' log level logTrace :: (?callStack :: GHC.CallStack) => MonadIO m => T.Text -> m ()-logTrace = doLog LogTrace ?callStack+logTrace = doLogCs LogTrace ?callStack . toLogStr  -- | Log with 'LogDebug' log level logDebug :: (?callStack :: GHC.CallStack) => MonadIO m => T.Text -> m ()-logDebug = doLog LogDebug ?callStack+logDebug = doLogCs LogDebug ?callStack . toLogStr  -- | Log with 'LogInfo' log level logInfo :: (?callStack :: GHC.CallStack) => MonadIO m => T.Text -> m ()-logInfo = doLog LogInfo ?callStack+logInfo = doLogCs LogInfo ?callStack . toLogStr  -- | Log with 'LogNote' log level logNote :: (?callStack :: GHC.CallStack) => MonadIO m => T.Text -> m ()-logNote = doLog LogNote ?callStack+logNote = doLogCs LogNote ?callStack . toLogStr  -- | Log with 'LogWarn' log level logWarn :: (?callStack :: GHC.CallStack) => MonadIO m => T.Text -> m ()-logWarn = doLog LogWarn ?callStack+logWarn = doLogCs LogWarn ?callStack . toLogStr  -- | Log with 'LogError' log level logError :: (?callStack :: GHC.CallStack) => MonadIO m => T.Text -> m ()-logError = doLog LogError ?callStack+logError = doLogCs LogError ?callStack . toLogStr  -- | Log on error level and call 'fail' logFail :: (?callStack :: GHC.CallStack, MonadFail m) => MonadIO m => T.Text -> m a logFail t =-    do doLog LogError ?callStack t+    do doLogCs LogError ?callStack (toLogStr t)        fail (T.unpack t)  -- | Log with 'LogTrace' level when the given expression is evaluated@@ -106,21 +108,17 @@  doPureLog ::LogLevel -> GHC.CallStack -> T.Text -> a -> a doPureLog ll cs txt expr =-    unsafePerformIO (doLog ll cs txt) `seq` expr+    unsafePerformIO (doLogCs ll cs $ toLogStr txt) `seq` expr -doLog :: MonadIO m => LogLevel -> GHC.CallStack -> T.Text -> m ()-doLog ll cs txt =++doLog :: MonadIO m => LogLevel -> LogStr -> LogStr -> m ()+doLog ll loc txt =     liftIO $     readIORef logLevel >>= \logLim ->     when (ll >= logLim) $     do lgrs <- readIORef loggers        time <- l_timeCache lgrs-       let loc =-               case GHC.getCallStack cs of-                   ((_, l):_) ->-                       GHC.srcLocFile l <> ":" <> show (GHC.srcLocStartLine l)-                   _ -> "unknown"-           msg =+       let msg =                "[" <> renderLevel <> " "                <> toLogStr time                <> " "@@ -150,6 +148,15 @@               LogWarn -> "\o33[0;33m"               LogError -> "\o33[1;31m" +doLogCs :: MonadIO m => LogLevel -> GHC.CallStack -> LogStr -> m ()+doLogCs ll cs txt =+    do let loc =+             case GHC.getCallStack cs of+               ((_, l):_) ->+                 GHC.srcLocFile l <> ":" <> show (GHC.srcLocStartLine l)+               _ -> "unknown"+       doLog ll (toLogStr loc) txt+ loggers :: IORef Loggers loggers =     unsafePerformIO $@@ -195,3 +202,22 @@  timeFormat :: TimeFormat timeFormat = "%Y-%m-%d %T %z"++-- | An adapter to implemend `MonadLogger` instances for custom monad stacks+monadLoggerAdapter :: (ML.ToLogStr msg, MonadIO m) => ML.Loc -> ML.LogSource -> ML.LogLevel -> msg -> m ()+monadLoggerAdapter loc _ lvl msg =+  doLog level location (toLogStr msg)+  where+    location =+      toLogStr $ ML.loc_filename loc <> ":" <> show (fst (ML.loc_start loc))+    level =+      case lvl of+        ML.LevelDebug -> LogDebug+        ML.LevelInfo -> LogInfo+        ML.LevelWarn -> LogWarn+        ML.LevelError -> LogError+        ML.LevelOther _ -> LogTrace++-- | Runs a logging transformer stack using the simple logger as backend+runSimpleLoggingT :: MonadIO m => ML.LoggingT m a -> m a+runSimpleLoggingT = flip ML.runLoggingT monadLoggerAdapter

stack.yaml view

@@ -1,1 +1,2 @@-resolver: lts-15.13+resolver:+  url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/25.yaml