git.iko.soy/typeable/control-logger
on 81a76a5 help sign in
2478ebf
swap
0 ahead, 9 behind
4 files changed+58−102
since splitsnapshots
unifiedsplit
control-logger.cabal+43−51 src/Control/Logger.hs+8−32 src/Control/Logger/Internal.hs+5−17 src/Control/Logger/Orphans.hs+2−2
control-logger.cabal+43−51
@@ -1,55 +1,47 @@
1−cabal-version: 2.4
2−name: control-logger
3−version: 0.1.0.0
4−synopsis: Logger used by all projects
5−license-file: LICENSE
6−build-type: Simple
1+cabal-version: 2.4
2+name: control-logger
3+version: 0.1.0.0
4+synopsis: Logger used by all projects
5+license-file: LICENSE
6+build-type: Simple
77
88library
9− hs-source-dirs: src
10− ghc-options: -Wall
11−
9+ hs-source-dirs: src
10+ ghc-options: -Wall
1211 if !impl(ghcjs)
13− exposed-modules:
14− Control.Logger
15− Control.Logger.Katip
16− Control.Logger.Katip.Utils
17− Control.Logger.Orphans
18−
19− exposed-modules: Control.Logger.Internal
20− build-depends:
21− , aeson
22− , base >=4.11
23− , bytestring
24− , control-has
25− , control-has-katip
26− , deepseq
27− , exceptions
28− , fast-logger >=2.4.11
29− , http-client
30− , lens
31− , monad-logger
32− , mtl
33− , shakespeare
34− , text
35− , time
36− , unordered-containers
37−
12+ exposed-modules: Control.Logger
13+ Control.Logger.Katip
14+ Control.Logger.Katip.Utils
15+ Control.Logger.Orphans
16+ exposed-modules: Control.Logger.Internal
17+ build-depends: base
18+ , aeson
19+ , bytestring
20+ , control-has
21+ , control-has-katip
22+ , deepseq
23+ , exceptions
24+ , fast-logger
25+ , http-client
26+ , lens
27+ , monad-logger
28+ , mtl
29+ , shakespeare
30+ , text
31+ , time
32+ , unordered-containers
3833 if !impl(ghcjs)
39− build-depends:
40− , katip >=0.8.8.0
41− , optparse-applicative
42−
43− default-language: Haskell2010
44− default-extensions:
45− ConstraintKinds
46− DataKinds
47− DeriveGeneric
48− FlexibleContexts
49− FlexibleInstances
50− LambdaCase
51− OverloadedStrings
52− RankNTypes
53− RecordWildCards
54− ScopedTypeVariables
55− TypeSynonymInstances
34+ build-depends: katip >= 0.8.8.0
35+ , optparse-applicative
36+ default-language: Haskell2010
37+ default-extensions: RankNTypes
38+ DataKinds
39+ FlexibleContexts
40+ FlexibleInstances
41+ LambdaCase
42+ OverloadedStrings
43+ ScopedTypeVariables
44+ DeriveGeneric
45+ ConstraintKinds
46+ RecordWildCards
47+ TypeSynonymInstances
src/Control/Logger.hs+8−32
@@ -3,8 +3,6 @@ module Control.Logger
33 ( Logger
44 , loggerContext
55 , scrubber
6− , censor
7− , censorWith
86 , logMsg
97 , logMsgWith
108 , logInfo
@@ -36,7 +34,6 @@ module Control.Logger
3634 , st
3735 , ToObject(..)
3836 , withScrubber
39− , censoringWith
4037 , censoring
4138 ) where
4239
@@ -44,9 +41,7 @@ import Control.Has
4441import Control.Lens hiding (censoring)
4542import Control.Logger.Internal
4643import Control.Logger.Orphans ()
47−import Control.Monad
4844import Control.Monad.Catch
49−import Control.Monad.IO.Class
5045import qualified Data.List as List
5146import Data.Monoid
5247import Data.Text (Text)
@@ -56,6 +51,10 @@ import GHC.Stack
5651import Katip (ToObject (..))
5752import System.Log.FastLogger
5853import Text.Shakespeare.Text (st)
54+#if MIN_VERSION_mtl(2,3,0)
55+import Control.Monad
56+import Control.Monad.IO.Class
57+#endif
5958
6059logError
6160 :: (LoggingMonad r m)
@@ -109,21 +108,7 @@ logErrorWith
109108 -> m ()
110109logErrorWith logger msg = withFrozenCallStack (logMsgWith logger Error msg)
111110
112−safeReplace :: Text -> Text -> Text -> Text
113−safeReplace what with where_
114− | Text.null what = where_
115− | otherwise = Text.replace what with where_
116−
117−-- | Add a some text to scrubber
118−censorWith :: Text -> Text -> Logger -> Logger
119−censorWith replacement needle l =
120− l & scrubber <>~ Endo (safeReplace needle replacement)
121−
122−-- | Censor with "***"
123−censor :: Text -> Logger -> Logger
124−censor = censorWith "***"
125−
126−-- | Run an action with adjusted scrubber
111+-- | Adjust the scrubbing function.
127112withScrubber
128113 :: forall r m a. (Has Logger r, MonadReader r m)
129114 => (Endo Text -> Endo Text)
@@ -134,24 +119,15 @@ withScrubber scrubF = local expandScrubber
134119 expandScrubber :: r -> r
135120 expandScrubber = over part (over scrubber scrubF)
136121
137−-- | Run an action while censoring additional text from logs
138−censoringWith
139− :: (Has Logger r, MonadReader r m)
140− => Text
141− -> Text
142− -> m a
143− -> m a
144−censoringWith replacement txt = withScrubber (<> censored)
145− where
146− censored = Endo (safeReplace txt replacement)
147−
148122-- | Run an action while censoring additional text from logs
149123censoring
150124 :: (Has Logger r, MonadReader r m)
151125 => Text
152126 -> m a
153127 -> m a
154−censoring = censoringWith "***"
128+censoring txt = withScrubber (<> censored)
129+ where
130+ censored = Endo (Text.replace txt "XXXX")
155131
156132-- | Log exceptions occured in computation and just ignore them.
157133tryLogError
src/Control/Logger/Internal.hs+5−17
@@ -16,12 +16,14 @@ module Control.Logger.Internal
1616
1717import Control.Has
1818import Control.Lens
19−import Control.Monad.IO.Class
2019import Control.DeepSeq
21−import Data.Aeson (ToJSON, FromJSON, Object, Value(..))
20+import Data.Aeson (ToJSON, FromJSON, Object)
2221import Data.Text (Text)
2322import Data.Monoid
2423import GHC.Stack
24+#if MIN_VERSION_mtl(2,3,0)
25+import Control.Monad.IO.Class
26+#endif
2527
2628
2729data LogSeverity
@@ -77,18 +79,4 @@ logMsgWith logger s t =
7779 liftIO $ runLogger logger callStack s t
7880
7981runLogger :: Logger -> CallStack -> LogSeverity -> Text -> IO ()
80−runLogger (Logger ctx theScrubber logger) cs ls txt
81− = logger (scrubContext theScrubber ctx) cs ls (appEndo theScrubber txt)
82−
83−
84−scrubContext :: Endo Text -> Object -> Object
85−scrubContext theScrubber = fmap doScrub
86− where
87− doScrub :: Value -> Value
88− doScrub = \case
89− Object object -> Object (fmap doScrub object)
90− Array array -> Array (fmap doScrub array)
91− String string -> String (appEndo theScrubber string)
92− n@Number{} -> n
93− b@Bool{} -> b
94− n@Null -> n
82+runLogger (Logger ctx theScrubber logger) cs ls txt = logger ctx cs ls (appEndo theScrubber txt)
src/Control/Logger/Orphans.hs+2−2
@@ -10,7 +10,7 @@ import Control.EnvT
1010import Control.Has
1111import Control.Logger.Internal
1212import Control.Monad.Logger
13−import qualified Data.Text.Encoding as T
13+import qualified Data.Text as T
1414import GHC.Stack
1515
1616
@@ -21,7 +21,7 @@ instance (Has Logger r, MonadIO m)
2121 in withFrozenCallStack
2222 $ logMsg
2323 (mlLevelToLogSeverity level)
24− (T.decodeUtf8Lenient . fromLogStr . toLogStr $ msg)
24+ (T.pack . show . toLogStr $ msg)
2525
2626locToCallStack :: Loc -> CallStack
2727locToCallStack Loc {..} = fromCallSiteList