simple-log 0.8.3 → 0.8.4

raw patch · 5 files changed

+37/−8 lines, 5 filesdep +microlens

Dependencies added: microlens

Files

• simple-log.cabal +4/−2
• src/System/Log/Simple.hs +6/−1
• src/System/Log/Simple/Base.hs +13/−3
• src/System/Log/Simple/Monad.hs +9/−1
• tests/Test.hs +5/−1

@@ -1,7 +1,7 @@ Name:                 simple-log
-Version:              0.8.3
+Version:              0.8.4
 Synopsis:             Simple log for Haskell
-Description:          Log library for Haskell with removing unnecessary traces
+Description:          Log library for Haskell
 License:              BSD3
 License-file:         LICENSE
 Author:               Alexandr `Voidex` Ruchkin
@@ -29,6 +29,7 @@     exceptions >= 0.8 && < 0.9,
     filepath >= 1.4 && < 1.5,
     hformat == 0.2.*,
+    microlens == 0.4.*,
     microlens-platform == 0.3.*,
     mmorph == 1.0.*,
     mtl >= 2.2 && < 2.3,
@@ -60,4 +61,5 @@     base >= 4.0 && < 6,
     simple-log,
     hspec >= 2.3 && < 2.5,
+    microlens-platform == 0.3.*,
     text >= 0.11.0 && < 2.0.0

@@ -45,6 +45,8 @@ --test = do
 --	updateLogHandlers globalLog ([handler text (file \"test.log\")]:)
 --	runGlobalLog $ sendLog Info \"This will go to test.log too\"
+--	updateLogConfig globalLog (set (ix \"\") Debug)
+--	runGlobalLog $ sendLog Debug \"Now debug logs too\"
 -- @
 --
 module System.Log.Simple (
@@ -72,7 +74,10 @@ 	LogConfig(..), defCfg, logCfg, componentCfg, Log(..),
 	newLog, rootLog, getLog, subLog,
 	updateLogConfig, updateLogHandlers, writeLog, stopLog)
-import System.Log.Simple.Monad (MonadLog(..), LogT(..), noLog, withLog, runLog, sendLog, component, scope_, scope, scopeM, scoper, scoperM, trace)
+import System.Log.Simple.Monad (
+	MonadLog(..), LogT(..), noLog, withLog, runLog, sendLog,
+	component, scope_, scope, scopeM, scoper, scoperM, trace,
+	modifyLogConfig, modifyLogHandlers)
 import System.Log.Simple.Text
 import System.Log.Simple.Stream
 import System.Log.Simple.File

@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings, TemplateHaskell, RankNTypes #-}
+{-# LANGUAGE OverloadedStrings, TemplateHaskell, RankNTypes, TypeFamilies #-}
 
 module System.Log.Simple.Base (
 	Level(..), level, level_,
@@ -31,6 +31,7 @@ import Data.Time
 import Data.String
 import Lens.Micro.Platform
+import Lens.Micro.Internal
 import Text.Format
 
 
@@ -145,12 +146,23 @@ data LogConfig = LogConfig {
 	_logConfigMap ∷ Map Component Level }
 
+makeLenses ''LogConfig
+
 instance Default LogConfig where
 	def = LogConfig mempty
 
 instance Show LogConfig where
 	show (LogConfig cfg) = unlines [show comp ++ ":" ++ show lev | (comp, lev) ← M.toList cfg]
 
+type instance Index LogConfig = Component
+type instance IxValue LogConfig = Level
+
+instance Ixed LogConfig where
+	ix n = logConfigMap ∘ ix n
+
+instance At LogConfig where
+	at n = logConfigMap ∘ at n
+
 -- | Default log config — info level
 defCfg ∷ LogConfig
 defCfg = def
@@ -158,8 +170,6 @@ -- | Make log config by list of components and levels
 logCfg ∷ [(Component, Level)] → LogConfig
 logCfg = LogConfig ∘ M.fromList
-
-makeLenses ''LogConfig
 
 -- | Component config level lens
 componentCfg ∷ Component → Lens' LogConfig (Maybe Level)

@@ -13,6 +13,7 @@ 	component,
 	scope_, scope, scopeM, scoper, scoperM,
 	trace,
+	modifyLogConfig, modifyLogHandlers,
 	) where
 
 import Prelude hiding (log)
@@ -88,7 +89,6 @@ scope_ ∷ MonadLog m ⇒ Text → m a → m a
 scope_ s = localLog (subLog mempty (read ∘ T.unpack $ s))
 
-
 #if __GLASGOW_HASKELL__ < 800
 type HasCallStack = ?callStack ∷ CallStack
 
@@ -138,3 +138,11 @@ 	v ← act
 	log Trace $ T.concat [name, " = ", fromString . show $ v]
 	return v
+
+-- | Modify config, same as @updateLogConfig@, but within @MonadLog@
+modifyLogConfig ∷ MonadLog m ⇒ (LogConfig → LogConfig) → m LogConfig
+modifyLogConfig fn = askLog >>= flip updateLogConfig fn
+
+-- | Modify handlers, same as @updateLogHandlers@, but within @MonadLog@
+modifyLogHandlers ∷ MonadLog m ⇒ ([LogHandler] → [LogHandler]) → m ()
+modifyLogHandlers fn = askLog >>= flip updateLogHandlers fn

@@ -6,6 +6,7 @@ 
 import Data.Text (Text)
 import Test.Hspec
+import Lens.Micro.Platform
 
 import System.Log.Simple
 
@@ -24,6 +25,8 @@ 					sendLog Trace "But not traces"
 			sendLog Trace "Root doesn't log traces"
 			sendLog Info "Root logs infos"
+			_ ← modifyLogConfig (set (ix "") Trace)
+			sendLog Trace "But now root logs traces too"
 		msgs `shouldBe` validMsgs
 
 testCfg ∷ LogConfig
@@ -41,4 +44,5 @@ 	"TRACE app:foo> This is visible",
 	"DEBUG app:foo> And this is visible too",
 	"DEBUG app.sub:bar/baz/quux> Debugs here are visible",
-	"INFO :> Root logs infos"]
+	"INFO :> Root logs infos",
+	"TRACE :> But now root logs traces too"]