81a76a5 · typeable/control-logger

git.iko.soy/typeable/control-logger

Shell.nix + tidy up

commit81a76a59bde408fec35f91306fcd7ab916da5221 authorVille Tirronen <ville@typeable.io> dateTue 16 Apr 2024, 12:53 (2 years ago) parent5c2c6db

4 files changed+28−16

compare with master

unifiedsplit

default.nix+9 src/Control/Logger.hs+8−8 src/Control/Logger/Internal.hs+10−7 src/Control/Logger/Katip.hs+1−1

default.nixnew file+9

@@ -0,0 +1,9 @@

1+{ pkgs ? import <nixpkgs> {} }:

3+pkgs.mkShell {

4+ buildInputs = [

5+ pkgs.ghc

6+ pkgs.haskellPackages.cabal-install

7+ pkgs.zlib

8+ ];

9+}

src/Control/Logger.hs+8−8

@@ -111,13 +111,13 @@ logErrorWith logger msg = withFrozenCallStack (logMsgWith logger Error msg)

111111-- | Adjust the scrubbing function.

112112withScrubber

113113 :: forall r m a. (Has Logger r, MonadReader r m)

114− => Endo (Text -> Text)

114+ => (Endo Text -> Endo Text)

115115 -> m a

116116 -> m a

117117withScrubber scrubF = local expandScrubber

118118 where

119119 expandScrubber :: r -> r

120− expandScrubber = over part (over scrubber (appEndo scrubF))

120+ expandScrubber = over part (over scrubber scrubF)

121121

122122-- | Run an action while censoring additional text from logs

123123censoring

@@ -125,9 +125,9 @@ censoring

125125 => Text

126126 -> m a

127127 -> m a

128−censoring txt = withScrubber (Endo (. censored))

128+censoring txt = withScrubber (<> censored)

129129 where

130− censored = Text.replace txt "XXXX"

130+ censored = Endo (Text.replace txt "XXXX")

131131

132132-- | Log exceptions occured in computation and just ignore them.

133133tryLogError

@@ -179,14 +179,14 @@ fileLogger :: MonadIO m => FilePath -> m Logger

179179fileLogger fp = fastFunc <$> liftIO (newFileLoggerSet defaultBufSize fp)

180180

181181silentLogger :: Logger

182−silentLogger = Logger mempty id (\_ _ _ _ -> return ())

182+silentLogger = Logger mempty mempty (\_ _ _ _ -> return ())

183183

184184-- | Logger which flushes buffer after each message. This is useful with

185185-- stderrLogger.

186186flushingFastFunc

187187 :: LogSeverity -> LoggerSet -> Logger

188188flushingFastFunc minLogLevel loggerSet =

189− Logger mempty id $ \_ stack logLevel msg ->

189+ Logger mempty mempty $ \_ stack logLevel msg ->

190190 when (logLevel >= minLogLevel) $ do

191191 ts <- getCurrentTime

192192 pushLogStr loggerSet

@@ -210,14 +210,14 @@ flushingStderrLogger =

210210-- | Make our outdated 'Logger' of fast-logger's 'LoggerSet'

211211fastFunc :: LoggerSet -> Logger

212212fastFunc loggerSet =

213− Logger mempty id $ \_ _ _ msg -> pushLogStr loggerSet $ toLogStr msg

213+ Logger mempty mempty $ \_ _ _ msg -> pushLogStr loggerSet $ toLogStr msg

214214

215215type LogSource = Text

216216

217217-- | Default logger tests and same things.

218218defaultFastFunc :: LogSource -> LogSeverity -> LoggerSet -> Logger

219219defaultFastFunc loc minLogLevel loggerSet =

220− Logger mempty id $ \_ stack s msg -> when (s >= minLogLevel) $ do

220+ Logger mempty mempty $ \_ stack s msg -> when (s >= minLogLevel) $ do

221221 ts <- getCurrentTime

222222 pushLogStr loggerSet $ formatLogStr ts stack loc s (toLogStr msg)

223223

src/Control/Logger/Internal.hs+10−7

@@ -1,4 +1,5 @@

11{-# LANGUAGE TemplateHaskell #-}

2+{-# LANGUAGE NamedFieldPuns #-}

23{-# LANGUAGE CPP #-}

45module Control.Logger.Internal

@@ -18,6 +19,7 @@ import Control.Lens

1819import Control.DeepSeq

1920import Data.Aeson (ToJSON, FromJSON, Object)

2021import Data.Text (Text)

22+import Data.Monoid

2123import GHC.Stack

2224#if MIN_VERSION_mtl(2,3,0)

2325import Control.Monad.IO.Class

@@ -34,25 +36,26 @@ data LogSeverity

3436instance ToJSON LogSeverity

3537instance FromJSON LogSeverity

3638

37−data Logger

38− = Logger

39+data Logger = Logger

3940 { _loggerContext :: Object

40− , _scrubber :: Text -> Text

41+ , _scrubber :: Endo Text

4142 , _loggerAction :: Object -> CallStack -> LogSeverity -> Text -> IO ()

4243 } deriving Generic

4344

44−instance NFData Logger

45+instance NFData Logger where

46+ rnf Logger{_loggerContext, _scrubber, _loggerAction} =

47+ rnf _loggerContext `deepseq` rwhnf (appEndo _scrubber) `deepseq` rwhnf _loggerAction

4548

4649makeLenses ''Logger

4750

4851instance Semigroup Logger where

4952 (Logger ctx1 s1 l1) <> (Logger ctx2 s2 l2)

50− = Logger ctx' (s1 . s2)

53+ = Logger ctx' (s1 <> s2)

5154 $ \ctx stack s t -> l1 ctx stack s t >> l2 ctx stack s t

5255 where ctx' = ctx1 <> ctx2

5356

5457instance Monoid Logger where

55− mempty = Logger mempty id $ \_ _ _ _ -> pure ()

58+ mempty = Logger mempty mempty $ \_ _ _ _ -> pure ()

5659

5760type LoggingMonad r m =

5861 (MonadReader r m, Has Logger r, MonadIO m, HasCallStack)

@@ -76,4 +79,4 @@ logMsgWith logger s t =

7679 liftIO $ runLogger logger callStack s t

7780

7881runLogger :: Logger -> CallStack -> LogSeverity -> Text -> IO ()

79−runLogger (Logger ctx scrubber logger) cs ls txt = logger ctx cs ls (scrubber txt)

82+runLogger (Logger ctx theScrubber logger) cs ls txt = logger ctx cs ls (appEndo theScrubber txt)

src/Control/Logger/Katip.hs+1−1

@@ -56,7 +56,7 @@ instance LogItem Object where

5656 payloadKeys _ _ = AllKeys

5757

5858getKatipLogger :: KatipContextTState -> Logger

59−getKatipLogger katipCtx = Logger (toObject . ltsContext $ katipCtx) id

59+getKatipLogger katipCtx = Logger (toObject . ltsContext $ katipCtx) mempty

6060 $ \ ctx stack s msg ->

6161 let ?callStack = stack

6262 in